code.delx.au - gnu-emacs-elpa/blob - packages/shen-mode/shen-mode.el

   1 ;;; shen-mode.el --- A major mode for editing shen source code
   2
   3 ;; Copyright (C) 2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
   6 ;; Version: 0.1
   7 ;; Keywords: languages, shen
   8 ;; Description: A major mode for editing shen source code
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; A minor mode for editing shen source code.
  28
  29 ;;; Code:
  30 (require 'lisp-mode)
  31 (require 'cc-mode)
  32 (require 'shen-functions)
  33 (require 'imenu)
  34
  35 (defcustom shen-mode-hook '(turn-on-eldoc-mode)
  36   "Normal hook run when entering `shen-mode'."
  37   :type 'hook
  38   :group 'shen)
  39
  40 (defvar shen-mode-map
  41   (let ((map (make-sparse-keymap)))
  42     (set-keymap-parent map lisp-mode-shared-map)
  43     (substitute-key-definition 'indent-new-comment-line
  44                                'c-indent-new-comment-line
  45                                map global-map)
  46     (substitute-key-definition 'fill-paragraph 'c-fill-paragraph
  47                                map global-map)
  48     map)
  49   "Currently just inherits from `lisp-mode-shared-map'.")
  50
  51 \f
  52 ;;; Fontification
  53 (defconst shen-font-lock-keywords
  54   (eval-when-compile
  55     `(;; definitions
  56       (,(concat "(\\("
  57                 (regexp-opt
  58                  '("define" "defmacro" "defprolog" "/." "synonyms"))
  59                 "\\)\\>"
  60                 "[ \t]*(?"
  61                 "\\(\\sw+\\)?")
  62        (1 font-lock-keyword-face)
  63        (2 font-lock-function-name-face nil t))
  64       ("(\\(lambda\\)\\>[ \t]*(?\\(\\sw+\\)?"
  65        (1 font-lock-keyword-face)
  66        (2 font-lock-variable-name-face nil t))
  67       ;; data types
  68       ("(\\(datatype\\)\\>[ \t]*(?\\(\\sw+\\)?"
  69        (1 font-lock-keyword-face)
  70        (2 font-lock-type-face nil t))
  71       ;; variables
  72       ("\\<\\([A-Z]\\w*\\)\\>" . font-lock-variable-name-face)
  73       ;; control structures
  74       (,(concat
  75          "("
  76          (regexp-opt
  77           (append
  78            '("let" "=" "eval-without-reader-macros" "freeze" "type") ; generic
  79            '("if" "and" "or" "cond")) t) ; boolean
  80          "\\>") . 1)
  81       ;; errors
  82       ("(\\(error\\)\\>" 1 font-lock-warning-face)
  83       ;; built-in
  84       (,(concat
  85          "("
  86          (regexp-opt
  87           (mapcar
  88            (lambda (it) (format "%s" it))
  89            (append
  90             '(intern function)                          ; symbols
  91             '(pos tlstr cn str string?)                 ; strings
  92             '(set value)                                ; assignment
  93             '(cons hd tl cons?)                         ; lists
  94             '(absvector address-> <-address absvector?) ; vector
  95             '(pr read-byte open close)                  ; stream
  96             '(get-time)                                 ; time
  97             '(+ - * / > < >= <= number?)                ; arithmetic
  98             '(fst snd tupple?)                          ; tuple
  99             '(@s @v @p)
 100             '(put get)                  ; property lists
 101             '(simple-error trap-error error-to-string) ; error
 102             ;; predicates
 103             (mapcar
 104              (lambda (it) (format "%s?" it))
 105              '(boolean character complex congruent cons element empty float
 106                        integer number provable rational solved string symbol
 107                        tuple variable))
 108             ;; misc functions
 109             (mapcar #'car shen-functions)
 110             shen-more-functions))
 111           t)
 112          "\\>")
 113        1 font-lock-builtin-face)
 114       ;; external global variables
 115       (,(concat
 116          (regexp-opt
 117           (mapcar
 118            (lambda (cnst) (format "*%s*" cnst))
 119            '("language" "implementation" "port" "porters"
 120              "stinput" "home-directory" "version"
 121              "maximum-print-sequence-size" "printer" "macros")) t)
 122          "\\>")
 123        1 font-lock-builtin-face)))
 124   "Default expressions to highlight in Shen mode.")
 125
 126 (defvar shen-mode-syntax-table
 127   (let ((table (make-syntax-table)))
 128     (dolist (pair '((?@  . "w")
 129                     (?_  . "w")
 130                     (?-  . "w")
 131                     (?+  . "w")
 132                     (??  . "w")
 133                     (?!  . "w")
 134                     (?<  . "w")
 135                     (?>  . "w")
 136                     (?/  . "w")
 137                     ;; comment delimiters
 138                     (?\\ . ". 14")
 139                     (?*  . ". 23")))
 140       (modify-syntax-entry (car pair) (cdr pair) table))
 141     table)
 142   "Syntax table to use in shen-mode.")
 143
 144 \f
 145 ;;; Indentation
 146 ;; Copied from qi-mode, which in turn is from scheme-mode and from lisp-mode
 147 (defun shen-indent-function (indent-point state)
 148   (let ((normal-indent (current-column)))
 149     (goto-char (1+ (elt state 1)))
 150     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 151     (if (and (elt state 2)
 152              (not (looking-at "\\sw\\|\\s_")))
 153       ;; car of form doesn't seem to be a symbol
 154       (progn
 155         (if (not (> (save-excursion (forward-line 1) (point))
 156                     calculate-lisp-indent-last-sexp))
 157           (progn (goto-char calculate-lisp-indent-last-sexp)
 158                  (beginning-of-line)
 159                  (parse-partial-sexp (point)
 160                                      calculate-lisp-indent-last-sexp 0 t)))
 161         ;; Indent under the list or under the first sexp on the same
 162         ;; line as calculate-lisp-indent-last-sexp.  Note that first
 163         ;; thing on that line has to be complete sexp since we are
 164         ;; inside the innermost containing sexp.
 165         (backward-prefix-chars)
 166         (current-column))
 167       (let ((function (buffer-substring (point)
 168                                         (progn (forward-sexp 1) (point))))
 169             method)
 170         (setq method (or (get (intern-soft function) 'shen-indent-function)
 171                          (get (intern-soft function) 'shen-indent-hook)))
 172         (cond ((or (eq method 'defun)
 173                    (and (null method)
 174                         (> (length function) 3)
 175                         (string-match "\\`def" function)))
 176                (lisp-indent-defform state indent-point))
 177               ((integerp method)
 178                (lisp-indent-specform method state
 179                                      indent-point normal-indent))
 180               (method
 181                (funcall method state indent-point normal-indent)))))))
 182
 183 (defun shen-let-indent (state indent-point normal-indent)
 184   (let ((edge (- (current-column) 2)))
 185     (goto-char indent-point) (skip-chars-forward " \t")
 186     (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
 187         ;; deeper indent because we're still defining local variables
 188         (lisp-indent-specform 5 state indent-point normal-indent)
 189       ;; shallow indent because we're in the body
 190       edge)))
 191
 192 (defun shen-package-indent (state indent-point normal-indent)
 193   (- (current-column) 8))
 194
 195 (put 'let 'shen-indent-function 'shen-let-indent)
 196 (put 'lambda 'shen-indent-function 1)
 197 (put 'package 'shen-indent-function 'shen-package-indent)
 198 (put 'datatype 'shen-indent-function 1)
 199
 200 \f
 201 ;;; Function documentation
 202 (defun shen-current-function ()
 203   (ignore-errors
 204     (save-excursion
 205       (backward-up-list)
 206       (forward-char 1)
 207       (thing-at-point 'word))))
 208
 209 (defun shen-mode-eldoc ()
 210   (let ((func (assoc (intern (or (shen-current-function) "")) shen-functions)))
 211     (when func
 212       (format "%s%s:%s"
 213               (propertize (symbol-name (car func))
 214                           'face 'font-lock-function-name-face)
 215               (if (cadr func)  (concat "[" (cadr func) "]") "")
 216               (if (caddr func) (concat " " (caddr func)) "")))))
 217
 218 (defvar shen-imenu-generic-expression
 219   '(("Functions" "^\\s-*(\\(define\\)" 1)))
 220
 221 \f
 222 ;;; Major mode definition
 223 ;; apparently some versions of Emacs don't have `prog-mode' defined
 224 (unless (fboundp 'prog-mode)
 225   (defalias 'prog-mode 'fundamental-mode))
 226
 227 (define-derived-mode shen-mode prog-mode "shen"
 228   "Major mode for editing Shen code."
 229   :syntax-table shen-mode-syntax-table
 230   ;; set a variety of local variables
 231   ((lambda (local-vars)
 232      (dolist (pair local-vars)
 233        (set (make-local-variable (car pair)) (cdr pair))))
 234    `((adaptive-fill-mode . nil)
 235      (fill-paragraph-function . lisp-fill-paragraph)
 236      (indent-line-function . lisp-indent-line)
 237      (lisp-indent-function . shen-indent-function)
 238      (parse-sexp-ignore-comments . t)
 239      (comment-start . "\\* ")
 240      (comment-end . " *\\")
 241      (comment-add . 0)
 242      (comment-column . 32)
 243      (parse-sexp-ignore-comments . t)
 244      (comment-use-global-state . nil)
 245      (eldoc-documentation-function . shen-mode-eldoc)
 246      (imenu-case-fold-search . t)
 247      (imenu-generic-expression . ,shen-imenu-generic-expression)
 248      (mode-name . "Shen")
 249      (font-lock-defaults . (shen-font-lock-keywords)))))
 250
 251 (add-to-list 'auto-mode-alist '("\\.shen\\'" . shen-mode))
 252
 253 (provide 'shen-mode)
 254 ;;; shen-mode.el ends here