├── .gitignore ├── README ├── inf-shen.el └── shen-mode.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | An Emacs major mode for shen. 2 | 3 | For more information on shen see 4 | http://www.shenlanguage.org 5 | 6 | To use put something like the following in your .emacs 7 | (require 'shen-mode) 8 | (require 'inf-shen) ; <- for interaction with an external shen process 9 | 10 | Shen-mode.el is now included in the GNU ELPA http://elpa.gnu.org/ and 11 | may be installed in new versions of Emacs using M-x list-packages. 12 | 13 | Inf-shen.el is not yet in the GNU ELPA (pending FSF copyright 14 | paperwork), until such time as it is incorporated into ELPA 15 | inf-shen.el may be obtained from this git repository. 16 | -------------------------------------------------------------------------------- /inf-shen.el: -------------------------------------------------------------------------------- 1 | ;;; inferior-shen-mode --- an inferior-shen mode 2 | 3 | ;; Copyright (C) 2007 Michael Ilseman 4 | ;; Copyright (C) 2011 Eric Schulte 5 | 6 | ;; Author: Michael Ilseman, Eric Schulte 7 | ;; Keywords: processes, shen 8 | 9 | ;;; Commentary: 10 | 11 | ;; A direct search-replace of inf-qi. 12 | 13 | ;; Mostly taken from inf-lisp.el. Pretty much a copy/paste, 14 | ;; search/replace with syntax highlighting added. 15 | 16 | ;; This file defines a shen-in-a-buffer package (inferior-shen mode) 17 | ;; built on top of comint mode. 18 | 19 | ;; Since this mode is built on top of the general command-interpreter-in- 20 | ;; a-buffer mode (comint mode), it shares a common base functionality, 21 | ;; and a common set of bindings, with all modes derived from comint mode. 22 | ;; This makes these modes easier to use. 23 | 24 | ;; For documentation on the functionality provided by comint mode, and 25 | ;; the hooks available for customising it, see the file comint.el. 26 | ;; For further information on inferior-shen mode, see the comments below. 27 | 28 | (eval-when-compile 29 | (require 'cl)) 30 | 31 | ;;; Code: 32 | (require 'comint) 33 | (require 'shen-mode) 34 | 35 | ;;;###autoload 36 | (defvar inferior-shen-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" 37 | "*What not to save on inferior Shen's input history. 38 | Input matching this regexp is not saved on the input history in Inferior Shen 39 | mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword 40 | \(as in :a, :c, etc.)") 41 | 42 | (defvar inferior-shen-mode-map nil) 43 | (unless inferior-shen-mode-map 44 | (setq inferior-shen-mode-map (copy-keymap comint-mode-map)) 45 | ; (set-keymap-parent inferior-shen-mode-map shen-mode-shared-map) 46 | (define-key inferior-shen-mode-map "\C-x\C-e" 'shen-eval-last-sexp) 47 | (define-key inferior-shen-mode-map "\C-c\C-l" 'shen-load-file) 48 | (define-key inferior-shen-mode-map "\C-c\C-k" 'shen-compile-file) 49 | (define-key inferior-shen-mode-map "\C-c\C-a" 'shen-show-arglist) 50 | (define-key inferior-shen-mode-map "\C-c\C-d" 'shen-describe-sym) 51 | (define-key inferior-shen-mode-map "\C-c\C-f" 52 | 'shen-show-function-documentation) 53 | (define-key inferior-shen-mode-map "\C-c\C-v" 54 | 'shen-show-variable-documentation)) 55 | 56 | ;;; These commands augment Shen mode, so you can process Shen code in 57 | ;;; the source files. 58 | (define-key shen-mode-map "\M-\C-x" 'shen-eval-defun) ; Gnu convention 59 | (define-key shen-mode-map "\C-x\C-e" 'shen-eval-last-sexp) ; Gnu convention 60 | (define-key shen-mode-map "\C-c\C-e" 'shen-eval-defun) 61 | (define-key shen-mode-map "\C-c\C-r" 'shen-eval-region) 62 | (define-key shen-mode-map "\C-c\C-c" 'shen-compile-defun) 63 | (define-key shen-mode-map "\C-c\C-z" 'switch-to-shen) 64 | (define-key shen-mode-map "\C-c\C-l" 'shen-load-file) 65 | (define-key shen-mode-map "\C-c\C-k" 'shen-compile-file) ; "kompile" file 66 | (define-key shen-mode-map "\C-c\C-a" 'shen-show-arglist) 67 | (define-key shen-mode-map "\C-c\C-d" 'shen-describe-sym) 68 | (define-key shen-mode-map "\C-c\C-f" 'shen-show-function-documentation) 69 | (define-key shen-mode-map "\C-c\C-v" 'shen-show-variable-documentation) 70 | 71 | 72 | ;;; This function exists for backwards compatibility. 73 | ;;; Previous versions of this package bound commands to C-c 74 | ;;; bindings, which is not allowed by the gnumacs standard. 75 | 76 | ;;; "This function binds many inferior-shen commands to C-c bindings, 77 | ;;;where they are more accessible. C-c bindings are reserved for the 78 | ;;;user, so these bindings are non-standard. If you want them, you should 79 | ;;;have this function called by the inferior-shen-load-hook: 80 | ;;; (setq inferior-shen-load-hook '(inferior-shen-install-letter-bindings)) 81 | ;;;You can modify this function to install just the bindings you want." 82 | (defun inferior-shen-install-letter-bindings () 83 | (define-key shen-mode-map "\C-ce" 'shen-eval-defun-and-go) 84 | (define-key shen-mode-map "\C-cr" 'shen-eval-region-and-go) 85 | (define-key shen-mode-map "\C-cc" 'shen-compile-defun-and-go) 86 | (define-key shen-mode-map "\C-cz" 'switch-to-shen) 87 | (define-key shen-mode-map "\C-cl" 'shen-load-file) 88 | (define-key shen-mode-map "\C-ck" 'shen-compile-file) 89 | (define-key shen-mode-map "\C-ca" 'shen-show-arglist) 90 | (define-key shen-mode-map "\C-cd" 'shen-describe-sym) 91 | (define-key shen-mode-map "\C-cf" 'shen-show-function-documentation) 92 | (define-key shen-mode-map "\C-cv" 'shen-show-variable-documentation) 93 | 94 | (define-key inferior-shen-mode-map "\C-cl" 'shen-load-file) 95 | (define-key inferior-shen-mode-map "\C-ck" 'shen-compile-file) 96 | (define-key inferior-shen-mode-map "\C-ca" 'shen-show-arglist) 97 | (define-key inferior-shen-mode-map "\C-cd" 'shen-describe-sym) 98 | (define-key inferior-shen-mode-map "\C-cf" 'shen-show-function-documentation) 99 | (define-key inferior-shen-mode-map "\C-cv" 100 | 'shen-show-variable-documentation)) 101 | 102 | 103 | ;;;###autoload 104 | (defvar inferior-shen-program "shen" 105 | "*Program name for invoking an inferior Shen with for Inferior Shen mode.") 106 | 107 | ;;;###autoload 108 | (defvar inferior-shen-load-command "(load \"%s\")\n" 109 | "*Format-string for building a Shen expression to load a file. 110 | This format string should use `%s' to substitute a file name 111 | and should result in a Shen expression that will command the inferior Shen 112 | to load that file. The default works acceptably on most Shens. 113 | The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\" 114 | produces cosmetically superior output for this application, 115 | but it works only in Common Shen.") 116 | 117 | ;;;###autoload 118 | (defvar inferior-shen-prompt "^[^> \n]*>+:? *" 119 | "Regexp to recognise prompts in the Inferior Shen mode. 120 | Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, 121 | and franz. This variable is used to initialize `comint-prompt-regexp' in the 122 | Inferior Shen buffer. 123 | 124 | This variable is only used if the variable 125 | `comint-use-prompt-regexp-instead-of-fields' is non-nil. 126 | 127 | More precise choices: 128 | Lucid Common Shen: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" 129 | franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" 130 | kcl: \"^>+ *\" 131 | 132 | This is a fine thing to set in your .emacs file.") 133 | 134 | (defvar inferior-shen-buffer nil "*The current inferior-shen process buffer. 135 | 136 | MULTIPLE PROCESS SUPPORT 137 | =========================================================================== 138 | To run multiple Shen processes, you start the first up 139 | with \\[inferior-shen]. It will be in a buffer named `*inferior-shen*'. 140 | Rename this buffer with \\[rename-buffer]. You may now start up a new 141 | process with another \\[inferior-shen]. It will be in a new buffer, 142 | named `*inferior-shen*'. You can switch between the different process 143 | buffers with \\[switch-to-buffer]. 144 | 145 | Commands that send text from source buffers to Shen processes -- 146 | like `shen-eval-defun' or `shen-show-arglist' -- have to choose a process 147 | to send to, when you have more than one Shen process around. This 148 | is determined by the global variable `inferior-shen-buffer'. Suppose you 149 | have three inferior Shens running: 150 | Buffer Process 151 | foo inferior-shen 152 | bar inferior-shen<2> 153 | *inferior-shen* inferior-shen<3> 154 | If you do a \\[shen-eval-defun] command on some Shen source code, 155 | what process do you send it to? 156 | 157 | - If you're in a process buffer (foo, bar, or *inferior-shen*), 158 | you send it to that process. 159 | - If you're in some other buffer (e.g., a source file), you 160 | send it to the process attached to buffer `inferior-shen-buffer'. 161 | This process selection is performed by function `inferior-shen-proc'. 162 | 163 | Whenever \\[inferior-shen] fires up a new process, it resets 164 | `inferior-shen-buffer' to be the new process's buffer. If you only run 165 | one process, this does the right thing. If you run multiple 166 | processes, you can change `inferior-shen-buffer' to another process 167 | buffer with \\[set-variable].") 168 | 169 | ;;;###autoload 170 | (defvar inferior-shen-mode-hook '() 171 | "*Hook for customising Inferior Shen mode.") 172 | 173 | (put 'inferior-shen-mode 'mode-class 'special) 174 | 175 | (defun inferior-shen-mode () 176 | "Major mode for interacting with an inferior Shen process. 177 | Runs a Shen interpreter as a subprocess of Emacs, with Shen I/O through an 178 | Emacs buffer. Variable `inferior-shen-program' controls which Shen interpreter 179 | is run. Variables `inferior-shen-prompt', `inferior-shen-filter-regexp' and 180 | `inferior-shen-load-command' can customize this mode for different Shen 181 | interpreters. 182 | 183 | For information on running multiple processes in multiple buffers, see 184 | documentation for variable `inferior-shen-buffer'. 185 | 186 | \\{inferior-shen-mode-map} 187 | 188 | Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and 189 | `inferior-shen-mode-hook' (in that order). 190 | 191 | You can send text to the inferior Shen process from other buffers containing 192 | Shen source. 193 | switch-to-shen switches the current buffer to the Shen process buffer. 194 | shen-eval-defun sends the current defun to the Shen process. 195 | shen-compile-defun compiles the current defun. 196 | shen-eval-region sends the current region to the Shen process. 197 | shen-compile-region compiles the current region. 198 | 199 | Prefixing the shen-eval/compile-defun/region commands with 200 | a \\[universal-argument] causes a switch to the Shen process buffer after sending 201 | the text. 202 | 203 | Commands: 204 | Return after the end of the process' output sends the text from the 205 | end of process to point. 206 | Return before the end of the process' output copies the sexp ending at point 207 | to the end of the process' output, and sends it. 208 | Delete converts tabs to spaces as it moves back. 209 | Tab indents for Shen; with argument, shifts rest 210 | of expression rigidly with the current line. 211 | C-M-q does Tab on each line starting within following expression. 212 | Paragraphs are separated only by blank lines. Semicolons start comments. 213 | If you accidentally suspend your process, use \\[comint-continue-subjob] 214 | to continue it." 215 | (interactive) 216 | (comint-mode) 217 | (set (make-local-variable 'font-lock-defaults) '(shen-font-lock-keywords)) 218 | (setq comint-prompt-regexp inferior-shen-prompt) 219 | (setq major-mode 'inferior-shen-mode) 220 | (setq mode-name "Inferior Shen") 221 | (setq mode-line-process '(":%s")) 222 | 223 | (use-local-map inferior-shen-mode-map) ;c-c c-k for "kompile" file 224 | (setq comint-get-old-input (function shen-get-old-input)) 225 | (setq comint-input-filter (function shen-input-filter)) 226 | (run-hooks 'inferior-shen-mode-hook)) 227 | 228 | (defun shen-get-old-input () 229 | "Return a string containing the sexp ending at point." 230 | (save-excursion 231 | (let ((end (point))) 232 | (backward-sexp) 233 | (buffer-substring (point) end)))) 234 | 235 | (defun shen-input-filter (str) 236 | "t if STR does not match `inferior-shen-filter-regexp'." 237 | (not (string-match inferior-shen-filter-regexp str))) 238 | 239 | ;;;###autoload 240 | (defun inferior-shen (cmd) 241 | "Run an inferior Shen process, input and output via buffer `*inferior-shen*'. 242 | If there is a process already running in `*inferior-shen*', just switch 243 | to that buffer. 244 | With argument, allows you to edit the command line (default is value 245 | of `inferior-shen-program'). Runs the hooks from 246 | `inferior-shen-mode-hook' (after the `comint-mode-hook' is run). 247 | \(Type \\[describe-mode] in the process buffer for a list of commands.)" 248 | (interactive (list (if current-prefix-arg 249 | (read-string "Run shen: " inferior-shen-program) 250 | inferior-shen-program))) 251 | (if (not (comint-check-proc "*inferior-shen*")) 252 | (let ((cmdlist (split-string cmd))) 253 | (set-buffer (apply (function make-comint) 254 | "inferior-shen" (car cmdlist) nil (cdr cmdlist))) 255 | (inferior-shen-mode))) 256 | (setq inferior-shen-buffer "*inferior-shen*") 257 | (pop-to-buffer "*inferior-shen*")) 258 | ;;;###autoload (add-hook 'same-window-buffer-names "*inferior-shen*") 259 | 260 | ;;;###autoload 261 | (defalias 'run-shen 'inferior-shen) 262 | 263 | (defcustom shen-pre-eval-hook '() 264 | "Hook to run on code before sending it to the inferior-shen-process. 265 | Functions on this hook will be called with an active region 266 | containing the shen source code about to be evaluated.") 267 | 268 | (defun shen-remember-functions (start end) 269 | "Add functions defined between START and END to `shen-functions'." 270 | (interactive "r") 271 | (flet ((clean (text) 272 | (when text 273 | (set-text-properties 0 (length text) nil text) text))) 274 | (save-excursion 275 | (goto-char start) 276 | (let ((re (concat 277 | "^(define[ \t]+\\(.+\\)[\n\r]" ; function name 278 | "\\([ \t]*\\\\\\*[ \t]*\\([^\000]+?\\)[ \t]*\\*\\\\\\)?" ; doc 279 | "[\n\r]?[ \t]*\\({\\(.+\\)}\\)?"))) ; type 280 | (while (re-search-forward re end t) 281 | (let ((name (intern (match-string 1))) 282 | (doc (clean (match-string 3))) 283 | (type (clean (match-string 5)))) 284 | (add-to-list 'shen-functions (list name type doc)))))))) 285 | 286 | (add-hook 'shen-pre-eval-hook #'shen-remember-functions) 287 | 288 | (defun check-balanced-parens (start end) 289 | "Check if parentheses in the region are balanced." 290 | (save-restriction (save-excursion 291 | (let ((deactivate-mark nil)) 292 | (condition-case c 293 | (progn (narrow-to-region start end) (goto-char (point-min)) 294 | (while (/= 0 (- (point) (forward-list)))) t) 295 | (scan-error (signal 'scan-error '("Parentheses not balanced.")))))))) 296 | 297 | (add-hook 'shen-pre-eval-hook 298 | (lambda (start end) 299 | (condition-case err (check-balanced-parens start end) 300 | (error (unless (y-or-n-p (format "%s Eval anyway ?" 301 | (error-message-string err))) 302 | (signal 'scan-error err)))))) 303 | 304 | (defun shen-eval-region (start end &optional and-go) 305 | "Send the current region to the inferior Shen process. 306 | Prefix argument means switch to the Shen buffer afterwards." 307 | (interactive "r\nP") 308 | (let ((before-input (marker-position (process-mark (inferior-shen-proc)))) 309 | result) 310 | 311 | (run-hook-with-args 'shen-pre-eval-hook start end) 312 | (comint-send-region (inferior-shen-proc) start end) 313 | (comint-send-string (inferior-shen-proc) "\n") 314 | (accept-process-output (inferior-shen-proc)) 315 | (sit-for 0) 316 | (save-excursion 317 | (set-buffer inferior-shen-buffer) 318 | (goto-char before-input) 319 | (setq result (buffer-substring (point) (point-at-eol))) 320 | (message "%s" result) 321 | (goto-char (process-mark (inferior-shen-proc)))) 322 | (if and-go (switch-to-shen t)) 323 | result)) 324 | 325 | (defun shen-eval-defun (&optional and-go) 326 | "Send the current defun to the inferior Shen process. 327 | Prefix argument means switch to the Shen buffer afterwards." 328 | (interactive "P") 329 | (let (result) 330 | (save-excursion 331 | (end-of-defun) 332 | (skip-chars-backward " \t\n\r\f") ; Makes allegro happy 333 | (let ((end (point))) 334 | (beginning-of-defun) 335 | (setq result (shen-eval-region (point) end)))) 336 | (if and-go (switch-to-shen t)) 337 | result)) 338 | 339 | (defun shen-eval-last-sexp (&optional and-go) 340 | "Send the previous sexp to the inferior Shen process. 341 | Prefix argument means switch to the Shen buffer afterwards." 342 | (interactive "P") 343 | (shen-eval-region (save-excursion (backward-sexp) (point)) (point) and-go)) 344 | 345 | ;;; Common Shen COMPILE sux. 346 | (defun shen-compile-region (start end &optional and-go) 347 | "Compile the current region in the inferior Shen process. 348 | Prefix argument means switch to the Shen buffer afterwards." 349 | (interactive "r\nP") 350 | (comint-send-string 351 | (inferior-shen-proc) 352 | (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n" 353 | (buffer-substring start end))) 354 | (if and-go (switch-to-shen t))) 355 | 356 | (defun shen-compile-defun (&optional and-go) 357 | "Compile the current defun in the inferior Shen process. 358 | Prefix argument means switch to the Shen buffer afterwards." 359 | (interactive "P") 360 | (save-excursion 361 | (end-of-defun) 362 | (skip-chars-backward " \t\n\r\f") ; Makes allegro happy 363 | (let ((e (point))) 364 | (beginning-of-defun) 365 | (shen-compile-region (point) e))) 366 | (if and-go (switch-to-shen t))) 367 | 368 | (defun switch-to-shen (eob-p) 369 | "Switch to the inferior Shen process buffer. 370 | With argument, positions cursor at end of buffer." 371 | (interactive "P") 372 | (if (get-buffer-process inferior-shen-buffer) 373 | (let ((pop-up-frames 374 | ;; Be willing to use another frame 375 | ;; that already has the window in it. 376 | (or pop-up-frames 377 | (get-buffer-window inferior-shen-buffer t)))) 378 | (pop-to-buffer inferior-shen-buffer)) 379 | (run-shen inferior-shen-program)) 380 | (when eob-p 381 | (push-mark) 382 | (goto-char (point-max)))) 383 | 384 | 385 | ;;; Now that shen-compile/eval-defun/region takes an optional prefix arg, 386 | ;;; these commands are redundant. But they are kept around for the user 387 | ;;; to bind if he wishes, for backwards functionality, and because it's 388 | ;;; easier to type C-c e than C-u C-c C-e. 389 | (defun shen-eval-region-and-go (start end) 390 | "Send the current region to the inferior Shen, and switch to its buffer." 391 | (interactive "r") 392 | (shen-eval-region start end t)) 393 | 394 | (defun shen-eval-defun-and-go () 395 | "Send the current defun to the inferior Shen, and switch to its buffer." 396 | (interactive) 397 | (shen-eval-defun t)) 398 | 399 | (defun shen-compile-region-and-go (start end) 400 | "Compile the current region in the inferior Shen, and switch to its buffer." 401 | (interactive "r") 402 | (shen-compile-region start end t)) 403 | 404 | (defun shen-compile-defun-and-go () 405 | "Compile the current defun in the inferior Shen, and switch to its buffer." 406 | (interactive) 407 | (shen-compile-defun t)) 408 | 409 | ;;; A version of the form in H. Shevis' soar-mode.el package. Less robust. 410 | ;;; (defun shen-compile-sexp (start end) 411 | ;;; "Compile the s-expression bounded by START and END in the inferior shen. 412 | ;;; If the sexp isn't a DEFUN form, it is evaluated instead." 413 | ;;; (cond ((looking-at "(defun\\s +") 414 | ;;; (goto-char (match-end 0)) 415 | ;;; (let ((name-start (point))) 416 | ;;; (forward-sexp 1) 417 | ;;; (process-send-string "inferior-shen" 418 | ;;; (format "(compile '%s #'(lambda " 419 | ;;; (buffer-substring name-start 420 | ;;; (point))))) 421 | ;;; (let ((body-start (point))) 422 | ;;; (goto-char start) (forward-sexp 1) ; Can't use end-of-defun. 423 | ;;; (process-send-region "inferior-shen" 424 | ;;; (buffer-substring body-start (point)))) 425 | ;;; (process-send-string "inferior-shen" ")\n")) 426 | ;;; (t (shen-eval-region start end))))) 427 | ;;; 428 | ;;; (defun shen-compile-region (start end) 429 | ;;; "Each s-expression in the current region is compiled (if a DEFUN) 430 | ;;; or evaluated (if not) in the inferior shen." 431 | ;;; (interactive "r") 432 | ;;; (save-excursion 433 | ;;; (goto-char start) (end-of-defun) (beginning-of-defun) ; error check 434 | ;;; (if (< (point) start) (error "region begins in middle of defun")) 435 | ;;; (goto-char start) 436 | ;;; (let ((s start)) 437 | ;;; (end-of-defun) 438 | ;;; (while (<= (point) end) ; Zip through 439 | ;;; (shen-compile-sexp s (point)) ; compiling up defun-sized chunks. 440 | ;;; (setq s (point)) 441 | ;;; (end-of-defun)) 442 | ;;; (if (< s end) (shen-compile-sexp s end))))) 443 | ;;; 444 | ;;; End of HS-style code 445 | 446 | 447 | (defvar shen-prev-l/c-dir/file nil 448 | "Record last directory and file used in loading or compiling. 449 | This holds a cons cell of the form `(DIRECTORY . FILE)' 450 | describing the last `shen-load-file' or `shen-compile-file' command.") 451 | 452 | (defvar shen-source-modes '(shen-mode) 453 | "*Used to determine if a buffer contains Shen source code. 454 | If it's loaded into a buffer that is in one of these major modes, it's 455 | considered a Shen source file by `shen-load-file' and `shen-compile-file'. 456 | Used by these commands to determine defaults.") 457 | 458 | (defun shen-load-file (file-name) 459 | "Load a Shen file into the inferior Shen process." 460 | (interactive (comint-get-source "Load Shen file: " shen-prev-l/c-dir/file 461 | shen-source-modes nil)) ; NIL because LOAD 462 | ; doesn't need an exact name 463 | (comint-check-source file-name) ; Check to see if buffer needs saved. 464 | (setq shen-prev-l/c-dir/file (cons (file-name-directory file-name) 465 | (file-name-nondirectory file-name))) 466 | (comint-send-string (inferior-shen-proc) 467 | (format inferior-shen-load-command file-name)) 468 | (switch-to-shen t)) 469 | 470 | 471 | (defun shen-compile-file (file-name) 472 | "Compile a Shen file in the inferior Shen process." 473 | (interactive (comint-get-source "Compile Shen file: " shen-prev-l/c-dir/file 474 | shen-source-modes nil)) ; NIL = don't need 475 | ; suffix .shen 476 | (comint-check-source file-name) ; Check to see if buffer needs saved. 477 | (setq shen-prev-l/c-dir/file (cons (file-name-directory file-name) 478 | (file-name-nondirectory file-name))) 479 | (comint-send-string (inferior-shen-proc) (concat "(compile-file \"" 480 | file-name 481 | "\"\)\n")) 482 | (switch-to-shen t)) 483 | 484 | 485 | 486 | ;;; Documentation functions: function doc, var doc, arglist, and 487 | ;;; describe symbol. 488 | ;;; =========================================================================== 489 | 490 | ;;; Command strings 491 | ;;; =============== 492 | 493 | (defvar shen-function-doc-command 494 | "(let ((fn '%s)) 495 | (format t \"Documentation for ~a:~&~a\" 496 | fn (documentation fn 'function)) 497 | (values))\n" 498 | "Command to query inferior Shen for a function's documentation.") 499 | 500 | (defvar shen-var-doc-command 501 | "(let ((v '%s)) 502 | (format t \"Documentation for ~a:~&~a\" 503 | v (documentation v 'variable)) 504 | (values))\n" 505 | "Command to query inferior Shen for a variable's documentation.") 506 | 507 | (defvar shen-arglist-command 508 | "(let ((fn '%s)) 509 | (format t \"Arglist for ~a: ~a\" fn (arglist fn)) 510 | (values))\n" 511 | "Command to query inferior Shen for a function's arglist.") 512 | 513 | (defvar shen-describe-sym-command 514 | "(describe '%s)\n" 515 | "Command to query inferior Shen for a variable's documentation.") 516 | 517 | 518 | ;;; Ancillary functions 519 | ;;; =================== 520 | 521 | ;;; Reads a string from the user. 522 | (defun shen-symprompt (prompt default) 523 | (list (let* ((prompt (if default 524 | (format "%s (default %s): " prompt default) 525 | (concat prompt ": "))) 526 | (ans (read-string prompt))) 527 | (if (zerop (length ans)) default ans)))) 528 | 529 | 530 | ;;; Adapted from function-called-at-point in help.el. 531 | (defun shen-fn-called-at-pt () 532 | "Returns the name of the function called in the current call. 533 | The value is nil if it can't find one." 534 | (condition-case nil 535 | (save-excursion 536 | (save-restriction 537 | (narrow-to-region (max (point-min) (- (point) 1000)) (point-max)) 538 | (backward-up-list 1) 539 | (forward-char 1) 540 | (let ((obj (read (current-buffer)))) 541 | (and (symbolp obj) obj)))) 542 | (error nil))) 543 | 544 | 545 | ;;; Adapted from variable-at-point in help.el. 546 | (defun shen-var-at-pt () 547 | (condition-case () 548 | (save-excursion 549 | (forward-sexp -1) 550 | (skip-chars-forward "'") 551 | (let ((obj (read (current-buffer)))) 552 | (and (symbolp obj) obj))) 553 | (error nil))) 554 | 555 | 556 | ;;; Documentation functions: fn and var doc, arglist, and symbol describe. 557 | ;;; ====================================================================== 558 | (defun shen-show-function-documentation (fn) 559 | "Send a command to the inferior Shen to give documentation for function FN. 560 | See variable `shen-function-doc-command'." 561 | (interactive (shen-symprompt "Function doc" (shen-fn-called-at-pt))) 562 | (comint-proc-query (inferior-shen-proc) 563 | (format shen-function-doc-command fn))) 564 | 565 | (defun shen-show-variable-documentation (var) 566 | "Send a command to the inferior Shen to give documentation for function FN. 567 | See variable `shen-var-doc-command'." 568 | (interactive (shen-symprompt "Variable doc" (shen-var-at-pt))) 569 | (comint-proc-query (inferior-shen-proc) (format shen-var-doc-command var))) 570 | 571 | (defun shen-show-arglist (fn) 572 | "Send a query to the inferior Shen for the arglist for function FN. 573 | See variable `shen-arglist-command'." 574 | (interactive (shen-symprompt "Arglist" (shen-fn-called-at-pt))) 575 | (comint-proc-query (inferior-shen-proc) (format shen-arglist-command fn))) 576 | 577 | (defun shen-describe-sym (sym) 578 | "Send a command to the inferior Shen to describe symbol SYM. 579 | See variable `shen-describe-sym-command'." 580 | (interactive (shen-symprompt "Describe" (shen-var-at-pt))) 581 | (comint-proc-query (inferior-shen-proc) 582 | (format shen-describe-sym-command sym))) 583 | 584 | 585 | ;; "Returns the current inferior Shen process. 586 | ;; See variable `inferior-shen-buffer'." 587 | (defun inferior-shen-proc () 588 | (let ((proc (get-buffer-process (if (eq major-mode 'inferior-shen-mode) 589 | (current-buffer) 590 | inferior-shen-buffer)))) 591 | (or proc 592 | (error "No Shen subprocess; see variable `inferior-shen-buffer'")))) 593 | 594 | 595 | ;;; Do the user's customisation... 596 | ;;;=============================== 597 | (defvar inferior-shen-load-hook nil 598 | "This hook is run when the library `inf-shen' is loaded. 599 | This is a good place to put keybindings.") 600 | 601 | (run-hooks 'inferior-shen-load-hook) 602 | 603 | (provide 'inf-shen) 604 | ;;; inf-shen.el ends here 605 | -------------------------------------------------------------------------------- /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 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 . 24 | 25 | ;;; Commentary: 26 | 27 | ;; A minor mode for editing shen source code. Shen is a modern lisp 28 | ;; dialect with support for functional and declarative programming, 29 | ;; pattern matching and a very powerful type system. See the 30 | ;; following for more information on Shen. http://www.shenlanguage.org 31 | 32 | ;;; Code: 33 | (require 'lisp-mode) 34 | (require 'imenu) 35 | 36 | (defcustom shen-mode-hook '(turn-on-eldoc-mode) 37 | "Normal hook run when entering `shen-mode'." 38 | :type 'hook 39 | :group 'shen) 40 | 41 | (defvar shen-mode-map 42 | (let ((map (make-sparse-keymap))) 43 | (set-keymap-parent map lisp-mode-shared-map) 44 | map) 45 | "Currently just inherits from `lisp-mode-shared-map'.") 46 | 47 | (defconst shen-functions 48 | '((* "number --> number --> number" "Number multiplication.") 49 | (+ "number --> number --> number" "Number addition.") 50 | (- "number --> number --> number" "Number subtraction.") 51 | (/ "number --> number --> number" "Number division.") 52 | (/. "_" "Abstraction builder, receives a variable and an expression; does the job of --> in the lambda calculus.") 53 | (< "number --> number --> boolean" "Less than.") 54 | (<-vector nil nil) 55 | (<= "number --> number --> boolean" "Less than or equal to.") 56 | ( nil nil) 57 | (= "A --> A --> boolean" "Equal to.") 58 | (== "A --> B --> boolean" "Equal to.") 59 | (> "number --> number --> boolean" "Greater than.") 60 | (>= "number --> number --> boolean" "Greater than or equal to.") 61 | (@p "_" "Takes two inputs and forms an ordered pair.") 62 | (@s "_" "Takes two or more inputs and forms a string.") 63 | (@v "_" "Takes two or more inputs and forms a vector.") 64 | (abort nil "throw a simple error") 65 | (adjoin nil "add arg1 to list arg2 if not already a member") 66 | (and "boolean --> boolean --> boolean" "Boolean and.") 67 | (append "(list A) --> (list A) --> (list A)" "Appends two lists into one list.") 68 | (apply "(A --> B) --> (A --> B)" "Applies a function to an input.") 69 | (arity nil nil) 70 | (assoc nil nil) 71 | (assoc-type "symbol --> variable --> symbol" "Associates a Qi type (first input) with Lisp type (second input)..") 72 | (average nil "return the average of two numbers") 73 | (bind nil nil) 74 | (boolean\? "A --> boolean" "Recognisor for booleans.") 75 | (bound\? nil "check is a symbol is bound") 76 | (byte->string nil "return the string represented by bytes") 77 | (call nil nil) 78 | (cd "string --> string" "Changes the home directory. (cd \"My Programs\") will cause (load \"hello_world.txt\") to load MyPrograms/hello_world.txt. (cd \"\") is the default.") 79 | (character\? "A --> boolean" "Recognisor for characters.") 80 | (compile nil nil) 81 | (complex\? "A --> boolean" "Recognisor for complex numbers.") 82 | (concat "symbol --> symbol --> symbol" "Concatenates two symbols.") 83 | (congruent\? "A --> A --> boolean" "Retrns true if objects are identical or else if they are strings or characters which are identical differing at most in case or numbers of equal value (e.g. 1 and 1.0) or tuples composed of congruent elements.") 84 | (cons "_" "A special form that takes an object e of type A and a list l of type (list A) and produces a list of type (list A) by adding e to the front of l.") 85 | (cons\? "--> boolean" "Returns true iff the input is a non-empty list.") 86 | (core nil nil) 87 | (cut nil nil) 88 | (debug "A --> string" "The input is ignored and debugging is returned; but all terminal output is echoed to the file debug.txt until the undebug function is executed.") 89 | (declare "_" "Takes a function name f and a type t expressed as a list and gives f the type t.") 90 | (define "_" "Define a function, takes a name, an optional type and a pattern matching body.") 91 | (delete-file "string --> string" "The file named in the string is deleted and the string returned.") 92 | (destroy "_" "Receives the name of a function and removes it and its type from the environment.") 93 | (difference "(list A) --> (list A) --> (list A)" "Subtracts the elements of the second list from the first") 94 | (do "_" "A special form: receives n well-typed expressions and evaluates each one, returning the normal form of the last one.") 95 | (dump "string --> string" "Dumps all user-generated Lisp from the file f denoted by the argument into a file f.lsp.") 96 | (echo "string --> string" "Echoes all terminal input/output to a file named by string (which is either appended to if it exists or created if not) until the command (echo \"\") is received which switches echo off.") 97 | (element\? "A -> (list A) --> boolean" "Returns true iff the first input is an element in the second.") 98 | (empty\? "--> boolean" "Returns true iff the input is [].") 99 | (error "_" "A special form: takes a string followed by n (n --> 0) expressions. Prints error string.") 100 | (eval "_" "Evaluates the input.") 101 | (explode "A --> (list character)" "Explodes an object to a list of characters.") 102 | (fail nil nil) 103 | (fix "(A --> A) --> (A --> A)" "Applies a function to generate a fixpoint.") 104 | (float\? "A --> boolean" "Recognisor for floating point numbers.") 105 | (floor nil nil) 106 | (format nil "takes a stream, a format string and args, formats and prints to the stream") 107 | (freeze "A --> (lazy A)" "Returns a frozen version of its input.") 108 | (fst "(A * B) --> A" "Returns the first element of a tuple.") 109 | (fwhen nil nil) 110 | (gensym "_" "Generates a fresh symbol or variable from a string..") 111 | (get nil "gets property arg2 from object arg1") 112 | (get-array "(array A) --> (list number) --> A --> A" "3-place function that takes an array of elements of type A, an index to that array as a list of natural numbers and an expression E of type A. If an object is stored at the index, then it is returned, otherwise the normal form of E is returned.") 113 | (get-prop "_" "3-place function that takes a symbol S, a pointer P (which can be a string, symbol or number), and an expression E of any kind and returns the value pointed by P from S (if one exists) or the normal form of E otherwise.") 114 | (hash nil "hash an object") 115 | (hdv nil nil) 116 | (head "(list A) --> A" "Returns the first element of a list.") 117 | (identical nil nil) 118 | (if "boolean --> A --> A" "takes a boolean b and two expressions x and y and evaluates x if b evaluates to true and evaluates y if b evaluates to false.") 119 | (if-with-checking "string --> (list A)" "If type checking is enabled, raises the string as an error otherwise returns the empty list..") 120 | (if-without-checking "string --> (list A)" "If type checking is disabled, raises the string as an error otherwise returns the empty list.") 121 | (include "(list symbol) --> (list symbol)" "Includes the datatype theories or synonyms for use in type checking.") 122 | (include-all-but "(list symbol) --> (list symbol)" "Includes all loaded datatype theories and synonyms for use in type checking apart from those entered.") 123 | (inferences "A --> number" "The input is ignored. Returns the number of logical inferences executed since the last call to the top level.") 124 | (input "_" "0-place function. Takes a user input i and returns the normal form of i.") 125 | (input+ "_" "Special form. Takes inputs of the form : . Where d() is the type denoted by the choice of expression (e.g. \"number\" denotes the type number). Takes a user input i and returns the normal form of i given i is of the type d().") 126 | (integer\? "A --> boolean" "Recognisor for integers.") 127 | (interror nil nil) 128 | (intersection "(list A) --> (list A) --> (list A)" "Computes the intersection of two lists.") 129 | (intmake-string nil nil) 130 | (intoutput nil nil) 131 | (lambda "_" "Lambda operator from lambda calculus.") 132 | (length "(list A) --> integer" "Returns the number of elements in a list.") 133 | (let nil nil) 134 | (limit nil nil) 135 | (lineread "_" "Top level reader of read-evaluate-print loop. Reads elements into a list. lineread terminates with carriage return when brackets are balanced. ^ aborts lineread.") 136 | (list "A .. A --> (list A)" "A special form. Assembles n (n --> 0) inputs into a list.") 137 | (load "string --> symbol" "Takes a file name and loads the file, returning loaded as a symbol.") 138 | (macroexpand nil nil) 139 | (make-string "string A1 - An --> string" "A special form: takes a string followed by n (n --> 0) well-typed expressions; assembles and returns a string.") 140 | (map "(A --> B) --> (list A) --> (list B)" "The first input is applied to each member of the second input and the results consed into one list..") 141 | (mapcan "(A --> (list B)) --> (list A) --> (list B)" "The first input is applied to each member of the second input and the results appended into one list.") 142 | (maxinferences "number --> number" "Returns the input and as a side-effect, sets a global variable to a number that limits the maximum number of inferences that can be expended on attempting to typecheck a program. The default is 1,000,000.") 143 | (mod nil "arg1 mod arg2") 144 | (newsym "symbol --> symbol" "Generates a fresh symbol from a symbol.") 145 | (newvar "variable --> variable" "Generates a fresh variable from a variable") 146 | (nl nil nil) 147 | (not "boolean --> boolean" "Boolean not.") 148 | (nth "number --> (list A) --> A" "Gets the nth element of a list numbered from 1.") 149 | (number\? "A --> boolean" "Recognisor for numbers.") 150 | (occurences "A --> B --> number" "Returns the number of times the first argument occurs in the second.") 151 | (occurrences nil "returns the number of occurrences of arg1 in arg2") 152 | (occurs-check "symbol --> boolean" "Receives either + or - and enables/disables occur checking in Prolog, datatype definitions and rule closures. The default is +.") 153 | (opaque "symbol --> symbol" "Applied to a Lisp macro makes it opaque to Qi.") 154 | (or "boolean --> (boolean --> boolean)" "Boolean or.") 155 | (output "string A1 - An --> string" "A special form: takes a string followed by n (n --> 0) well-typed expressions; prints a message to the screen and returns an object of type string (the string \"done\").") 156 | (preclude "(list symbol) --> (list symbol)" "Removes the mentioned datatype theories and synonyms from use in type checking.") 157 | (preclude-all-but "(list symbol) --> (list symbol)" "Removes all the datatype theories and synonyms from use in type checking apart from the ones given.") 158 | (print "A --> A" "Takes an object and prints it, returning it as a result.") 159 | (profile "(A --> B) --> (A --> B)" "Takes a function represented by a function name and inserts profiling code returning the function as an output.") 160 | (profile-results "A --> symbol" "The input is ignored. Returns a list of profiled functions and their timings since profile-results was last used.") 161 | (ps "_" "Receives a symbol denoting a Qi function and prints the Lisp source code associated with the function.") 162 | (put nil "puts value of arg3 as property arg2 in object arg1") 163 | (put-array "(array A) --> (list number) --> A --> A" "3-place function that takes an array of elements of type A, an index to that array as a list of natural numbers and an expression E of type A. The normal form of E is stored at that index and then returned.") 164 | (put-prop "_" "3-place function that takes a symbol S, a pointer P (a string symbol or number), and an expression E. The pointer P is set to point from S to the normal form of E which is then returned.") 165 | (quit "_" "0-place function that exits Qi.") 166 | (random "number --> number" "Given a positive number n, generates a random number between 0 and n-1.") 167 | (rational\? "A --> boolean" "Recognisor for rational numbers.") 168 | (read nil nil) 169 | (read-char "A --> character" "The input is discarded and the character typed by the user is returned.") 170 | (read-chars-as-stringlist "(list character) --> (character --> boolean) --> (list string)" "Returns a list of strings whose components are taken from the character list. The second input acts as a tokeniser. Thus (read-chars-as-stringlist [#\\H #\\i #\\Space #\\P #\\a #\\t] (/. X (= X #\\Space))) will produce [\"Hi\" \"Pat\"].") 171 | (read-file "string --> (list unit)" "Returns the contents of an ASCII file designated by a string. Returns a list of units, where unit is an unspecified type.") 172 | (read-file-as-charlist "string --> (list character)" "Returns the list of characters from the contents of an ASCII file designated by a string.") 173 | (read-file-as-string nil nil) 174 | (real\? "A --> boolean" "Recognisor for real numbers.") 175 | (remove "A --> (list A) --> (list A)" "Removes all occurrences of an element from a list.") 176 | (return nil nil) 177 | (reverse "(list A)--> ?(list A)" "Reverses a list.") 178 | (round "number--> ?number" "Rounds a number.") 179 | (save "_" "0 place function. Saves a Qi image.") 180 | (snd "(A * B) --> B" "Returns the second element of a tuple.") 181 | (specialise "symbol --> symbol" "Receives the name of a function and turns it into a special form. Special forms are not curried during evaluation or compilation.") 182 | (speed "number --> number" "Receives a value 0 to 3 and sets the performance of the generated Lisp code, returning its input. 0 is the lowest setting.") 183 | (spy "symbol --> boolean" "Receives either + or - and respectively enables/disables tracing the operation of T*.") 184 | (sqrt "number --> number" "Returns the square root of a number.") 185 | (step "symbol --> boolean" "Receives either + or - and enables/disables stepping in the trace.") 186 | (stinput nil nil) 187 | (string\? "A --> boolean" "Recognisor for strings.") 188 | (strong-warning "symbol --> boolean" "Takes + or -; if + then warnings are treated as error messages.") 189 | (subst nil nil) 190 | (sugar "symbol --> (A --> B) --> number --> (A --> B)" "Receives either in or out as first argument, a function f and an integer greater than 0 and returns f as a result. The function f is placed on the sugaring list at a position determined by the number.") 191 | (sugar-list "symbol --> (list symbol)" "Receives either in or out as first argument, and returns the list of sugar functions.") 192 | (sum nil "sum a list of numbers") 193 | (symbol\? "A --> boolean" "Recognisor for symbols.") 194 | (systemf nil nil) 195 | (tail "(list A) --> (list A)" "Returns all but the first element of a non-empty list.") 196 | (tc "symbol --> boolean" "Receives either + or - and respectively enables/disables static typing.") 197 | (tc\? nil "return true if type checking") 198 | (thaw "(lazy A) --> A" "Receives a frozen input and evaluates it to get the unthawed result..") 199 | (time "A --> A" "Prints the run time for the evaluation of its input and returns its normal form.") 200 | (tlv nil nil) 201 | (track "symbol --> symbol" "Tracks the I/O behaviour of a function.") 202 | (transparent "symbol --> symbol" "Applied to a Lisp macro makes it transparent to Qi.") 203 | (tuple\? "A --> boolean" "Recognisor for tuples.") 204 | (type "_" "Returns a type for its input (if any) or false if the input has no type.") 205 | (unassoc-type "symbol --> symbol" "Removes any associations with the Qi type in the type association table.") 206 | (undebug "A --> string" "The input is ignored, undebugging is returned and all terminal output is closed to the file debug.txt.") 207 | (unify nil nil) 208 | (unify! nil nil) 209 | (union "(list A) --> (list A) --> (list A)" "Forms the union of two lists.") 210 | (unprofile "(A --> B) --> (A --> B)" "Unprofiles a function.") 211 | (unspecialise "symbol --> symbol" "Receives the name of a function and deletes its special form status.") 212 | (unsugar "symbol --> (A --> B) --> (A --> B)" "Receives either out or in and the name of a function and removes its status as a sugar function.") 213 | (untrack "symbol --> symbol" "Untracks a function.") 214 | (value "_" "Applied to a symbol, returns the global value assigned to it.") 215 | (variable\? "A --> boolean" "Applied to a variable, returns true.") 216 | (vector nil nil) 217 | (vector-> nil nil) 218 | (vector\? nil nil) 219 | (version "string --> string" "Changes the version string displayed on startup.") 220 | (warn "string --> string" "Prints the string as a warning and returns \"done\". See strong-warning") 221 | (write-to-file "string --> A --> string" "Writes the second input into a file named in the first input. If the file does not exist, it is created, else it is overwritten. If the second input is a string then it is written to the file without the enclosing quotes. The first input is returned.") 222 | (y-or-n\? "string --> boolean" "Prints the string as a question and returns true for y and false for n.")) 223 | "Shen functions taken largely from the Qi documentation by Dr. Mark Tarver.") 224 | 225 | 226 | ;;; Fontification 227 | (defconst shen-font-lock-keywords 228 | (eval-when-compile 229 | `(;; definitions 230 | (,(concat "(\\(" 231 | (regexp-opt 232 | '("define" "defmacro" "defprolog" "/." "synonyms" "defcc")) 233 | "\\)\\>" 234 | "[ \t]*(?" 235 | "\\(\\sw+\\)?") 236 | (1 font-lock-keyword-face) 237 | (2 font-lock-function-name-face nil t)) 238 | ("(\\(lambda\\)\\>[ \t]*(?\\(\\sw+\\)?" 239 | (1 font-lock-keyword-face) 240 | (2 font-lock-variable-name-face nil t)) 241 | ;; data types 242 | ("(\\(datatype\\)\\>[ \t]*(?\\(\\sw+\\)?" 243 | (1 font-lock-keyword-face) 244 | (2 font-lock-type-face nil t)) 245 | ;; variables 246 | ("\\<\\([A-Z]\\w*\\)\\>" . font-lock-variable-name-face) 247 | ;; control structures 248 | (,(concat 249 | "(" 250 | (regexp-opt 251 | (append 252 | '("let" "=" "eval-without-reader-macros" "freeze" "type") ; generic 253 | '("if" "and" "or" "cond")) t) ; boolean 254 | "\\>") . 1) 255 | ;; errors 256 | ("(\\(error\\)\\>" 1 font-lock-warning-face) 257 | ;; built-in 258 | (,(concat 259 | "(" 260 | (regexp-opt 261 | (mapcar 262 | (lambda (it) (format "%s" it)) 263 | (append 264 | '(intern function) ; symbols 265 | '(pos tlstr cn str string?) ; strings 266 | '(set value) ; assignment 267 | '(cons hd tl cons?) ; lists 268 | '(absvector address-> <-address absvector?) ; vector 269 | '(pr read-byte open close) ; stream 270 | '(get-time) ; time 271 | '(+ - * / > < >= <= number?) ; arithmetic 272 | '(fst snd tupple?) ; tuple 273 | '(@s @v @p) 274 | '(put get) ; property lists 275 | '(simple-error trap-error error-to-string) ; error 276 | ;; predicates 277 | (mapcar 278 | (lambda (it) (format "%s?" it)) 279 | '(boolean character complex congruent cons element empty float 280 | integer number provable rational solved string symbol 281 | tuple variable)) 282 | ;; misc functions 283 | (mapcar #'car shen-functions))) 284 | t) 285 | "\\>") 286 | 1 font-lock-builtin-face) 287 | ;; external global variables 288 | (,(concat 289 | (regexp-opt 290 | (mapcar 291 | (lambda (cnst) (format "*%s*" cnst)) 292 | '("language" "implementation" "port" "porters" 293 | "stinput" "home-directory" "version" 294 | "maximum-print-sequence-size" "printer" "macros")) t) 295 | "\\>") 296 | 1 font-lock-builtin-face))) 297 | "Default expressions to highlight in Shen mode.") 298 | 299 | (defvar shen-mode-syntax-table 300 | (let ((table (make-syntax-table))) 301 | (dolist (pair '((?@ . "w") 302 | (?_ . "w") 303 | (?- . "w") 304 | (?+ . "w") 305 | (?? . "w") 306 | (?! . "w") 307 | (?< . "w") 308 | (?> . "w") 309 | (?/ . "w") 310 | ;; comment delimiters 311 | (?\\ . ". 124b") 312 | (?* . ". 23") 313 | (?\n . "> b"))) 314 | (modify-syntax-entry (car pair) (cdr pair) table)) 315 | table) 316 | "Syntax table to use in shen-mode.") 317 | 318 | 319 | ;;; Indentation 320 | ;; Copied from qi-mode, which in turn is from scheme-mode and from lisp-mode 321 | (defun shen-indent-function (indent-point state) 322 | (let ((normal-indent (current-column))) 323 | (goto-char (1+ (elt state 1))) 324 | (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) 325 | (if (and (elt state 2) 326 | (not (looking-at "\\sw\\|\\s_"))) 327 | ;; car of form doesn't seem to be a symbol 328 | (progn 329 | (if (not (> (save-excursion (forward-line 1) (point)) 330 | calculate-lisp-indent-last-sexp)) 331 | (progn (goto-char calculate-lisp-indent-last-sexp) 332 | (beginning-of-line) 333 | (parse-partial-sexp (point) 334 | calculate-lisp-indent-last-sexp 0 t))) 335 | ;; Indent under the list or under the first sexp on the same 336 | ;; line as calculate-lisp-indent-last-sexp. Note that first 337 | ;; thing on that line has to be complete sexp since we are 338 | ;; inside the innermost containing sexp. 339 | (backward-prefix-chars) 340 | (current-column)) 341 | (let ((function (buffer-substring (point) 342 | (progn (forward-sexp 1) (point)))) 343 | method) 344 | (setq method (or (get (intern-soft function) 'shen-indent-function) 345 | (get (intern-soft function) 'shen-indent-hook))) 346 | (cond ((or (eq method 'defun) 347 | (and (null method) 348 | (> (length function) 3) 349 | (string-match "\\`def" function))) 350 | (lisp-indent-defform state indent-point)) 351 | ((integerp method) 352 | (lisp-indent-specform method state 353 | indent-point normal-indent)) 354 | (method 355 | (funcall method state indent-point normal-indent))))))) 356 | 357 | (defun shen-let-indent (state indent-point normal-indent) 358 | (let ((edge (- (current-column) 2))) 359 | (goto-char indent-point) (skip-chars-forward " \t") 360 | (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]") 361 | ;; deeper indent because we're still defining local variables 362 | (lisp-indent-specform 5 state indent-point normal-indent) 363 | ;; shallow indent because we're in the body 364 | edge))) 365 | 366 | (defun shen-package-indent (state indent-point normal-indent) 367 | (- (current-column) 8)) 368 | 369 | (put 'let 'shen-indent-function 'shen-let-indent) 370 | (put 'lambda 'shen-indent-function 1) 371 | (put 'package 'shen-indent-function 'shen-package-indent) 372 | (put 'datatype 'shen-indent-function 1) 373 | 374 | 375 | ;;; Function documentation 376 | (defun shen-current-function () 377 | (ignore-errors 378 | (save-excursion 379 | (backward-up-list) 380 | (forward-char 1) 381 | (thing-at-point 'word)))) 382 | 383 | (defun shen-mode-eldoc () 384 | (let ((func (assoc (intern (or (shen-current-function) "")) shen-functions))) 385 | (when func 386 | (format "%s%s:%s" 387 | (propertize (symbol-name (car func)) 388 | 'face 'font-lock-function-name-face) 389 | (if (cadr func) (concat "[" (cadr func) "]") "") 390 | (if (caddr func) (concat " " (caddr func)) ""))))) 391 | 392 | (defvar shen-imenu-generic-expression 393 | '(("Functions" "^\\s-*(\\(define\\)" 1))) 394 | 395 | 396 | ;;; Major mode definition 397 | ;; apparently some versions of Emacs don't have `prog-mode' defined 398 | (unless (fboundp 'prog-mode) 399 | (defalias 'prog-mode 'fundamental-mode)) 400 | 401 | ;;;###autoload 402 | (define-derived-mode shen-mode prog-mode "shen" 403 | "Major mode for editing Shen code." 404 | :syntax-table shen-mode-syntax-table 405 | ;; set a variety of local variables 406 | ((lambda (local-vars) 407 | (dolist (pair local-vars) 408 | (set (make-local-variable (car pair)) (cdr pair)))) 409 | `((adaptive-fill-mode . nil) 410 | (fill-paragraph-function . lisp-fill-paragraph) 411 | (indent-line-function . lisp-indent-line) 412 | (lisp-indent-function . shen-indent-function) 413 | (parse-sexp-ignore-comments . t) 414 | (comment-start . "\\* ") 415 | (comment-end . " *\\") 416 | (comment-add . 0) 417 | (comment-column . 32) 418 | (parse-sexp-ignore-comments . t) 419 | (comment-use-global-state . nil) 420 | (comment-multi-line . t) 421 | (eldoc-documentation-function . shen-mode-eldoc) 422 | (imenu-case-fold-search . t) 423 | (imenu-generic-expression . ,shen-imenu-generic-expression) 424 | (mode-name . "Shen") 425 | (font-lock-defaults . (shen-font-lock-keywords))))) 426 | 427 | ;;;###autoload 428 | (add-to-list 'auto-mode-alist '("\\.shen\\'" . shen-mode)) 429 | 430 | (provide 'shen-mode) 431 | ;;; shen-mode.el ends here 432 | --------------------------------------------------------------------------------