rpl-tools/rpl-base.el

;;; -*- mode: emacs-lisp; lexical-binding: t -*-

;;; rpl-base.el -- basic setup for the RPL tools

;; Copyright (C) 2014 Paul Onions

;; Author: Paul Onions <paul.onions@acm.org>
;; Keywords: RPL, SysRPL, HP48, HP49, HP50

;; This file is free software, see the LICENCE file in this directory
;; for copying terms.

;;; Commentary:

;; Basic setup for the RPL tools.

;;; Code:
(require 'cl-lib)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customizations
;;
(defgroup rpl nil
  "Tools for working with the RPL calculator programming language.")

(defcustom rpl-sysrpl-data-file-prefix "sysrpl-data"
  "Filename prefix for files from which to `read' SysRPL data."
  :type 'string
  :group 'rpl)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions for generating/loading pre-computed data
;;
(defun rpl-make-sysrpl-data-filename (calculator)
  "Make the SysRPL data filename used for CALCULATOR.
Where CALCULATOR should be a keyword symbol identifying the
calculator model, e.g. :48G, :49G etc."
  (cl-assert (keywordp calculator))
  (concat rpl-sysrpl-data-file-prefix "." (substring (symbol-name calculator) 1) ".el"))

(defvar rpl-tools-data-dir
  (and load-file-name (concat (file-name-directory load-file-name) "data/"))
  "RPL tools data directory.")

(defun rpl-write-data-file (obj filename)
  "Write OBJ to FILENAME using function `print'.

The directory in which to write the file defaults to the value of
the variable `rpl-tools-data-dir'. This can be overridden by
specifying a different path in the FILENAME string (either
relative or absolute)."
  (let ((default-directory rpl-tools-data-dir))
    (with-temp-buffer
      (print obj (current-buffer))
      (write-region (point-min) (point-max) filename))))

(defun rpl-read-data-file (filename)
  "Read a Lisp object from FILENAME using function `read'.

The directory in which FILENAME resides is assumed to be the
value of the variable `rpl-tools-data-dir'. This can be
overridden by specifying a different path in the FILENAME
string (either relative or absolute)."
  (let ((default-directory rpl-tools-data-dir))
    (with-temp-buffer
      (insert-file-contents filename)
      (goto-char (point-min))
      (read (current-buffer)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Load SysRPL names files
;;
(message "Loading SysRPL information")

(defvar rpl-sysrpl-data-38g
  (rpl-read-data-file (rpl-make-sysrpl-data-filename :38G))
  "SysRPL data for the 38G calculator.")

(defvar rpl-sysrpl-data-39g
  (rpl-read-data-file (rpl-make-sysrpl-data-filename :39G))
  "SysRPL data for the 39G calculator.")

(defvar rpl-sysrpl-data-48g
  (rpl-read-data-file (rpl-make-sysrpl-data-filename :48G))
  "SysRPL data for the 48G calculator.")

(defvar rpl-sysrpl-data-49g
  (rpl-read-data-file (rpl-make-sysrpl-data-filename :49G))
  "SysRPL data for the 49G calculator.")

(defun rpl-sysrpl-data-get-names (data)
  (let ((names nil))
    (maphash (lambda (key val)
               (setq names (cons key names)))
             data)
    names))

(defun rpl-sysrpl-names (calculator)
  (cl-assert (keywordp calculator))
  (cond ((eql calculator :38G)
         (rpl-sysrpl-data-get-names rpl-sysrpl-data-38g))
        ((eql calculator :39G)
         (rpl-sysrpl-data-get-names rpl-sysrpl-data-39g))
        ((eql calculator :48G)
         (rpl-sysrpl-data-get-names rpl-sysrpl-data-48g))
        ((eql calculator :49G)
         (rpl-sysrpl-data-get-names rpl-sysrpl-data-49g))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Common keymap (including the ``RPL'' menu)
;;
(defvar rpl-menu-compile-file-enable nil)

(make-variable-buffer-local 'rpl-menu-compile-file-enable)

(defvar rpl-common-keymap
  (let ((map (make-sparse-keymap "RPL"))
        (menu-map (make-sparse-keymap "RPL")))
    (set-keymap-parent map prog-mode-map)
    ;; Key assignments
    (define-key map (kbd "C-c C-k") 'rpl-compile-file)
    ;; Menu items
    (define-key map [menu-bar rpl-menu] (cons "RPL" menu-map))
    (define-key menu-map [rpl-menu-compile-file]
      '(menu-item "Compile File..." rpl-compile-file
                  :enable rpl-menu-compile-file-enable))
    (define-key menu-map [rpl-menu-separator-1]
      '(menu-item "--"))
    (define-key menu-map [rpl-menu-apropos]
      '(menu-item "Apropos (at point)..." rpl-apropos-thing-at-point))
    map)
  "The RPL tools common keymap.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Developer utils
;;
(defvar rpl-debug nil)

(defmacro rpl-debug-message (msg)
  (if rpl-debug
      `(message ,msg)
    nil))

(defun rpl-force-reload ()
  (interactive)
  (load "rpl-base")
  (load "rpl-sysrpl-mode"))

(provide 'rpl-base)