;;; -*- mode: emacs-lisp; lexical-binding: t -*- ;;; sysrpl-mode.el -- Major mode for the SysRPL programming language ;; Copyright (C) 2014 Paul Onions ;; Author: Paul Onions ;; Keywords: RPL, SysRPL, HP48, HP49, HP50, calculator ;; This file is free software, see the LICENCE file in this directory ;; for copying terms. ;;; Commentary: ;; A major mode for the SysRPL language, the system programming ;; language of HP48/49/50-series calculators. ;;; Code: (require 'cl-lib) (require 'rpl-base) (require 'rpl-edb) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customizations ;; (defcustom sysrpl-default-calculator :HP50G "Default calculator type for SysRPL mode." :type '(radio :HP38G :HP39G :HP48G :HP49G :HP50G) :group 'rpl) (defcustom sysrpl-compiler-program "rplcomp" "External SysRPL compiler program name." :type 'string :group 'rpl) (defcustom sysrpl-compiler-output-bufname "*rplcomp*" "Buffer name in which to capture SysRPL compiler output." :type 'string :group 'rpl) (defface sysrpl-name '((t :foreground "darkblue")) "Face used for displaying SysRPL names (e.g DROP)." :group 'rpl) (defface sysrpl-keyword '((t :foreground "purple")) "Face used for displaying SysRPL keywords (e.g. :: ;)." :group 'rpl) (defface sysrpl-comment '((t :foreground "darkgreen")) "Face used for displaying SysRPL comments." :group 'rpl) (defcustom sysrpl-font-lock-name-face 'sysrpl-name "Name of face to use for displaying SysRPL names." :type 'symbol :group 'rpl) (defcustom sysrpl-font-lock-keyword-face 'sysrpl-keyword "Name of face to use for displaying SysRPL keywords." :type 'symbol :group 'rpl) (defcustom sysrpl-font-lock-comment-face 'sysrpl-comment "Name of face to use for displaying SysRPL comments." :type 'symbol :group 'rpl) (defun sysrpl-edb-calculator (calculator) "Map SysRPL calculator identifier to EDB identifier." (cond ((eql calculator :HP38G) :38G) ((eql calculator :HP39G) :39G) ((eql calculator :HP48G) :48G) ((eql calculator :HP49G) :49G) ((eql calculator :HP50G) :49G))) (defvar sysrpl-mode-syntax-table (let ((table (make-syntax-table prog-mode-syntax-table))) (modify-syntax-entry ?: "w" table) (modify-syntax-entry ?\; "w" table) (modify-syntax-entry ?! "w" table) (modify-syntax-entry ?@ "w" table) (modify-syntax-entry ?# "w" table) (modify-syntax-entry ?$ "w" table) (modify-syntax-entry ?% "w" table) (modify-syntax-entry ?^ "w" table) (modify-syntax-entry ?& "w" table) (modify-syntax-entry ?\? "w" table) (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?= "w" table) (modify-syntax-entry ?+ "w" table) (modify-syntax-entry ?* "w" table) (modify-syntax-entry ?/ "w" table) (modify-syntax-entry ?< "w" table) (modify-syntax-entry ?> "w" table) (modify-syntax-entry ?| "w" table) table) "The SysRPL syntax table.") (defvar sysrpl-rplcomp-keywords '("LAM" "ID" "TAG" "CHR" "CODE" "CODEM" "ENDCODE" "PTR" "ROMPTR" "FLASHPTR" "ZINT" "ARRY" "LNKARRY" "HXS" "GROB" "::" ";" "BEGIN" "AGAIN" "UNTIL" "WHILE" "REPEAT" "DO" "LOOP" "+LOOP" "IF" "ELSE" "THEN" "FCN" "ENDFCN" "{" "}" "ASSEMBLE" "RPL" "ASSEMBLEM" "!RPL" "ROMID" "xROMID" "NAME" "NULLNAME" "xNAME" "sNAME" "tNAME" "NAMELESS" "LABEL" "LOCALNAME" "LOCALLABEL" "EXTERNAL" "LOCAL" "FEXTERNAL" "DEFINE" "INCLUDE" "TITLE" "STITLE" "EJECT") "Keywords used by the RPLCOMP SysRPL compiler.") (defun sysrpl-font-lock-compile-keywords (names) "Construct a list of keyword matcher clauses suitable for `font-lock-keywords'." (append (list (list "^\\*.*$" (list 0 'sysrpl-font-lock-comment-face)) (list "(.*)" (list 0 'sysrpl-font-lock-comment-face)) (list (concat "\\<" (regexp-opt sysrpl-rplcomp-keywords) "\\>") (list 0 'sysrpl-font-lock-keyword-face))) (mapcar (lambda (str) (list (concat "\\<" (regexp-quote str) "\\>") (list 0 'sysrpl-font-lock-name-face))) names))) (defvar sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator sysrpl-default-calculator)))) (defvar sysrpl-selected-calculator sysrpl-default-calculator "Currently selected calculator model.") (defun sysrpl-select-hp38g () "Set the currently selected calculator model to be the HP38G." (interactive) (setq sysrpl-selected-calculator :HP38G) (setq sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator :HP38G)))) (sysrpl-mode)) (defun sysrpl-select-hp39g () "Set the currently selected calculator model to be the HP39G." (interactive) (setq sysrpl-selected-calculator :HP39G) (setq sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator :HP39G)))) (sysrpl-mode)) (defun sysrpl-select-hp48g () "Set the currently selected calculator model to be the HP48G." (interactive) (setq sysrpl-selected-calculator :HP48G) (setq sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator :HP48G)))) (sysrpl-mode)) (defun sysrpl-select-hp49g () "Set the currently selected calculator model to be the HP49G." (interactive) (setq sysrpl-selected-calculator :HP49G) (setq sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator :HP49G)))) (sysrpl-mode)) (defun sysrpl-select-hp50g () "Set the currently selected calculator model to be the HP50G." (interactive) (setq sysrpl-selected-calculator :HP50G) (setq sysrpl-font-lock-keywords (sysrpl-font-lock-compile-keywords (rpl-edb-all-names (sysrpl-edb-calculator :HP50G)))) (sysrpl-mode)) (defun sysrpl-get-eldoc-message () (interactive) (rpl-edb-get-stack-effect (sysrpl-edb-calculator sysrpl-selected-calculator) (thing-at-point 'word))) (defun sysrpl-apropos-thing-at-point (name) "Show information about NAME in a popup buffer. When called interactively NAME defaults to the word around point." (interactive (list (completing-read "Apropos: " (rpl-edb-all-names (sysrpl-edb-calculator sysrpl-selected-calculator)) nil nil (thing-at-point 'word)))) (let ((bufname (format "*SysRPL: %s*" name))) (with-current-buffer (get-buffer-create bufname) (setq buffer-read-only nil) (erase-buffer) (insert (rpl-edb-get-stack-effect (sysrpl-edb-calculator sysrpl-selected-calculator) name)) (newline) (insert (rpl-edb-get-description (sysrpl-edb-calculator sysrpl-selected-calculator) name)) (newline) (insert (format "Address: %s" (rpl-edb-get-address (sysrpl-edb-calculator sysrpl-selected-calculator) name))) (newline) (insert (format "Flags: %s" (rpl-edb-get-flags (sysrpl-edb-calculator sysrpl-selected-calculator) name))) (newline) (end-of-buffer) (help-mode) (set-buffer-modified-p nil) (setq buffer-read-only t)) (fit-window-to-buffer (display-buffer bufname)))) (defun sysrpl-compile-buffer () "Compile the current buffer." (interactive) (let ((tmp-filename (make-temp-file "sysrpl" nil ".s")) (rtn-code 0)) (write-region (point-min) (point-max) tmp-filename) (with-current-buffer (get-buffer-create sysrpl-compiler-output-bufname) (setq buffer-read-only nil) (erase-buffer) (setq rtn-code (call-process sysrpl-compiler-program tmp-filename t nil "-" "-"))) (display-buffer sysrpl-compiler-output-bufname) (if (eql rtn-code 0) (message "Compilation complete") (message "*** Compiled with ERRORS ***")))) (defvar sysrpl-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap))) (set-keymap-parent map rpl-common-keymap) ;; Menu items (define-key map [menu-bar rpl-menu] (cons "RPL" menu-map)) (define-key menu-map [sysrpl-menu-separator-1] '(menu-item "--")) (define-key menu-map [sysrpl-menu-select-hp50g] '(menu-item "HP50G" sysrpl-select-hp50g :button (:radio . (eql :HP50G sysrpl-selected-calculator)))) (define-key menu-map [sysrpl-menu-select-hp49g] '(menu-item "HP49G" sysrpl-select-hp49g :button (:radio . (eql :HP49G sysrpl-selected-calculator)))) (define-key menu-map [sysrpl-menu-select-hp48g] '(menu-item "HP48G" sysrpl-select-hp48g :button (:radio . (eql :HP48G sysrpl-selected-calculator)))) (define-key menu-map [sysrpl-menu-select-hp39g] '(menu-item "HP39G" sysrpl-select-hp39g :button (:radio . (eql :HP39G sysrpl-selected-calculator)))) (define-key menu-map [sysrpl-menu-select-hp38g] '(menu-item "HP38G" sysrpl-select-hp38g :button (:radio . (eql :HP38G sysrpl-selected-calculator)))) map) "The SysRPL mode local keymap.") (defvar sysrpl-mode-hook nil "Hook for customizing SysRPL mode.") (define-derived-mode sysrpl-mode prog-mode "SysRPL" "Major mode for the SysRPL language." :group 'rpl (make-local-variable 'eldoc-documentation-function) (setq eldoc-documentation-function 'sysrpl-get-eldoc-message) (setq font-lock-defaults (list 'sysrpl-font-lock-keywords)) (setq rpl-menu-compile-buffer-enable t) (setq rpl-menu-assemble-buffer-enable nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; End of file ;; (provide 'sysrpl-mode)