Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 690 lines (681 sloc) 33.063 kb
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
1 ;;; package --- Summary
2 ;; newlisp.el --- An Emacs mode for newlisp
3 ;; this file is not a part of gnu Emacs or Xemacs
4 ;; Author: Tim johnson <tim@johnsons-web.com> (TJ)
5 ;;
6 ;;; License:
7
8 ;; Copyright (C) 2006 Tim Johnson
9
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2 of
13 ;; the License, or (at your option) any later version.
14
15 ;; This program is distributed in the hope that it will be
16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
17 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
18 ;; PURPOSE. See the GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public
21 ;; License along with this program; if not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
23 ;; MA 02111-1307 USA
24
25 ;;; History:
26 ;; V 0.25
27 ;; 1)Added functions for sexp-cursor movement:
28 ;; newlisp-indent-and-move-next, newlisp-indent-and-move-back,
29 ;; newlisp-prev-opening-parens, newlisp-next-opening-parens,
30 ;; 2)Improved newlisp-next-function, newlisp-previous-function
31 ;; V 0.20
32 ;; 1)See additions by frontera000
33 ;; 2)newlisp-next-functionp: If cursor is at beginning of function '('
34 ;; move forward to enable search for next function
35 ;; 3)newlisp-delete-sexp: delete sexp nearest to cursor or from '(' or ')'
36 ;; 4)newlisp-context-qualify: upcase previous word and insert ':'
37 ;; V 0.10
38 ;; 1)Newlisp documentation is now parsed without preperation
39 ;; 2)One associative list is produced, for both one liners and verbose
40 ;; documentation. Discarded the use of dummy functions.
41 ;; 3)Added 'newlisp-clear-comint-buffer. If comint buffer is
42 ;; not open, will also open it.
43 ;; 4)Added newlisp-mode-hook so that you can make your own
44 ;; individual customizations via 'add-hook
45 ;; mode. V 0.002
46 ;; Originally a shameless hack of quack.el. Now a properly derived major
47 ;;; Commentary:
48 ;; Thanks to Stefan Monnier <monnier@iro.umontreal.ca> (SM)
49 ;; Thanks also to: johan bockgård <bojohan+news@dd.chalmers.se> (JB)
50 ;;
51 ;;; Related links and files
52 ;; http://www.johnsons-web.com/demo/emacs/derived-mode/dmode.el
53 ;; Mode template to "roll your own programming mode"
54 ;;
55 ;; 'Emacs' is meant to refer to *either* GNU Emacs *or* to the Xemacs fork
56 ;;
57 ;; About 'help-command': The standard Emacs installation maps control-h to the
58 ;; 'help-command' prefix. Sometimes control-h is mapped to backward-delete.
59 ;; if you have done so, then where 'c-h' is used in this file, substitute
60 ;; the appropriate prefix (such as F1)
61 ;;
62 ;;; Quickstart:
63 ;; control-c control-h
64 ;;; Code:
65 ;; ===========================================================================================
6fed2cc Fixed mispelling.
Nicholas E. May (on Enterprise) authored
66 (require 'scheme) ;; Inherit Scheme mode
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
67 (require 'tj-parenface) ;; Highlight parens and brackets
68 ;(require 'nl-doc-assoc) ;; Data structure holding documentation
69 ;; ===========================================================================================
70 (defvar newlisp-mode-hook nil
71 "*Hook called by `newlisp-mode'.")
72 ;; ===========================================================================================
73 (defvar newlisp-function-begin-regexp "(\\(?:def\\(?:ine\\|un\\)\\|fn\\)"
74 "Used to find function definitions. NOTE: No whitespace after parens!")
75 ;; ===========================================================================================
76 ;; 'helper' functions
77 ;; ===========================================================================================
78 (defun safe-kill-buff (n)
79 "kill a buffer, don't worry whether it exists."
80 (interactive)
81 (condition-case nil
82 (kill-buffer n)
83 (error nil) ) )
84 ;; ===========================================================================================
85 (defun newlisp-replace-newlines (S)
86 "Replace newlines in string 'S' with spaces.
87 Use for sending code to newlisp."
88 (mapconcat (lambda (x) x) (split-string S "\n") " "))
89 ;; ===========================================================================================
90 ;; 2008-03-12: Jeff Ober: was missing define-macro, lambda, lambda-macro
91 (defvar newlisp-function-names '("define" "define-macro" "fn" "lambda" "lambda-macro")
92 "Names of Newlisp function definitions")
93 ;; ===========================================================================================
94 (defun newlisp-at-function-startp ()
95 "Is cursor at the beginning of a function?"
96 (interactive)
97 (cond ((string-equal (char-to-string (char-after)) "(") ;; cursor on '('
98 (forward-char 1)
99 (cond ((member (current-word) newlisp-function-names)
100 (backward-char 1) ;; found. Reset
101 (message "found")
102 t)
103 (t ;; not found. Reset
104 (message "not found")
105 (backward-char 1) nil)))
106 (t nil)))
107 ;; ===========================================================================================
108 (put 'fn 'scheme-indent-function 1) ;; treat fn,letn,letex as a functions
109 (put 'letn 'scheme-indent-function 1) ;; CONTRIB: Rick Hanson
110 (put 'letex 'scheme-indent-function 1)
111 (put 'local 'scheme-indent-function 1) ;; CONTRIB: Jeff Ober
112 (put 'lambda-macro 'scheme-indent-function 1) ;; CONTRIB: Jeff Ober
113 ;; ===========================================================================================
114 ;; Create some faces for special fontification.
115 ;; NOTE: XEmacs seems to ignore the (background light) form.
116 ;; IOWS: You may need to use customize to set a readable color if using light background
117 ;; ===========================================================================================
118 (defface newlisp-font-lock-keywords-face
119 '((((class color) (background light)) (:foreground "green4"))
120 (((class color) (background dark)) (:foreground "yellow"))
121 (((class grayscale) (background light)) (:foreground "dimgray" :italic t))
122 (((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
123 (t (:bold t)))
124 "Font lock mode face used to highlight a syntax group for newlisp mode."
125 :group 'font-lock-faces)
126 (defvar newlisp-font-lock-keywords-face 'newlisp-font-lock-keywords-face)
127 ;; ===========================================================================================
128 (defface newlisp-font-lock-function-names-face
129 '((((class color) (background light)) (:foreground "darkcyan"))
130 (((class color) (background dark)) (:foreground "cyan"))
131 (((class grayscale) (background light)) (:foreground "dimgray" :italic t))
132 (((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
133 (t (:bold t)))
134 "Font lock mode face used to highlight functions (defun, define, fn) for newlisp mode."
135 :group 'font-lock-faces)
136 (defvar newlisp-font-lock-function-names-face 'newlisp-font-lock-function-names-face)
137 ;; ===========================================================================================
138 (defface newlisp-font-lock-user-keywords-face
139 '((((class color) (background light)) (:foreground "red4"))
140 (((class color) (background dark)) (:foreground "yellow3"))
141 (((class grayscale) (background light)) (:foreground "dimgray" :italic t))
142 (((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
143 (t (:bold t)))
144 "Font lock mode face used to highlight user-defined keywords for newlisp mode."
145 :group 'font-lock-faces)
146 (defvar newlisp-font-lock-user-keywords-face 'newlisp-font-lock-user-keywords-face)
147 ;; ===========================================================================================
148 (defface newlisp-font-lock-quote-face
149 '((((class color) (background light)) (:foreground "purple"))
150 ;; 2008-03-12 Jeff Ober: changed to plum from magenta. I *hate* magenta.
151 (((class color) (background dark)) (:foreground "plum"))
152 (((class grayscale) (background light)) (:foreground "dimgray" :italic t))
153 (((class grayscale) (background dark)) (:foreground "lightgray" :italic t))
154 (t (:bold t)))
155 "Font lock mode face used to highlight quoted symbols in newlisp mode."
156 :group 'font-lock-faces)
157 (defvar newlisp-font-lock-quote-face 'newlisp-font-lock-quote-face)
158 ;; ==========================================================================
159 (defconst
160 newlisp-function-names-regexp
161 (regexp-opt '("define" "defun" "fn")))
162 ;; ==========================================================================
163 ;; 2008-03-12 Jeff Ober: updated with 9.3.3's symbols [(map string (symbols))]
164 (defconst
165 newlisp-keywords-regexp
166 (regexp-opt '( ;; c-h f regexp-opt <ret>
167 "!" "!=" "$" "$0" "$1" "$10" "$11" "$12" "$13" "$14" "$15" "$2" "$3" "$4" "$5" "$6"
168 "$7" "$8" "$9" "$args" "$idx" "$main-args" "%" "&" "*" "+" "-" "/" ":" "<" "<<"
169 "<=" "=" ">" ">=" ">>" "?" "@" "MAIN" "NaN?" "^" "abs" "acos" "acosh" "add" "address"
170 "amb" "and" "append" "append-file" "apply" "args" "array" "array-list" "array?"
171 "asin" "asinh" "assoc" "assoc-set" "atan" "atan2" "atanh" "atom?" "base64-dec" "base64-enc"
172 "bayes-query" "bayes-train" "begin" "beta" "betai" "bind" "binomial" "callback"
173 "case" "catch" "ceil" "change-dir" "char" "chop" "clean" "close" "command-line"
174 "cond" "cons" "constant" "context" "context?" "copy-file" "cos" "cosh" "count" "cpymem"
175 "crc32" "crit-chi2" "crit-z" "current-line" "curry" "date" "date-value" "debug"
176 "dec" "def-new" "default" "define" "define-macro" "delete" "delete-file" "delete-url"
177 "destroy" "det" "device" "difference" "directory" "directory?" "div" "do-until"
178 "do-while" "doargs" "dolist" "dostring" "dotimes" "dotree" "dump" "dup" "empty?"
179 "encrypt" "ends-with" "env" "erf" "error-event" "error-number" "error-text" "eval"
180 "eval-string" "exec" "exists" "exit" "exp" "expand" "explode" "factor" "fft" "file-info"
181 "file?" "filter" "find" "find-all" "first" "flat" "float" "float?" "floor" "flt"
182 "for" "for-all" "fork" "format" "fv" "gammai" "gammaln" "gcd" "get-char" "get-float"
183 "get-int" "get-long" "get-string" "get-url" "global" "global?" "if" "ifft" "import"
184 "inc" "index" "int" "integer" "integer?" "intersect" "invert" "irr" "join" "lambda?"
185 "last" "legal?" "length" "let" "letex" "letn" "list" "list?" "load" "local" "log"
186 "lookup" "lower-case" "macro?" "main-args" "make-dir" "map" "mat" "match" "max"
187 "member" "min" "mod" "mul" "multiply" "name" "net-accept" "net-close" "net-connect"
188 "net-error" "net-eval" "net-listen" "net-local" "net-lookup" "net-peek" "net-peer"
189 "net-ping" "net-receive" "net-receive-from" "net-receive-udp" "net-select" "net-send"
190 "net-send-to" "net-send-udp" "net-service" "net-sessions" "new" "nil" "nil?" "normal"
191 "not" "now" "nper" "npv" "nth" "nth-set" "null?" "number?" "open" "or" "ostype"
192 "pack" "parse" "parse-date" "peek" "pipe" "pmt" "pop" "pop-assoc" "post-url" "pow"
193 "pretty-print" "primitive?" "print" "println" "prob-chi2" "prob-z" "process" "protected?"
194 "push" "put-url" "pv" "quote" "quote?" "rand" "random" "randomize" "read-buffer"
195 "read-char" "read-file" "read-key" "read-line" "real-path" "ref" "ref-all" "ref-set"
196 "regex" "remove-dir" "rename-file" "replace" "replace-assoc" "reset" "rest" "reverse"
197 "rotate" "round" "save" "search" "seed" "seek" "select" "semaphore" "sequence" "series"
198 "set" "set-assoc" "set-locale" "set-nth" "set-ref" "set-ref-all" "setq" "sgn" "share"
199 "signal" "silent" "sin" "sinh" "sleep" "slice" "sort" "source" "sqrt" "starts-with"
200 "string" "string?" "sub" "swap" "sym" "symbol?" "symbols" "sys-error" "sys-info"
201 "tan" "tanh" "throw" "throw-error" "time" "time-of-day" "timer" "title-case" "trace"
202 "trace-highlight" "transpose" "trim" "true" "true?" "unicode" "unify" "unique" "unless"
203 "unpack" "until" "upper-case" "utf8" "utf8len" "uuid" "wait-pid" "when" "while"
204 "write-buffer" "write-char" "write-file" "write-line" "xml-error" "xml-parse" "xml-type-tags"
205 "zero?" "|" "~"
206 )))
207 ;; ==========================================================================
208 (defconst
209 newlisp-user-keywords-regexp
210 (regexp-opt '( ;; c-h f regexp-opt <ret>
211 ;; for your own libraries
212 ;"aligned?" "even?" "ltrim" "ltrims" "parseint" "rtrim" "rtrims" "second" "third";; test
213 )))
214 ;; ==========================================================================
215 (defun newlisp-indent-and-move-next ()
216 "NOTE: Indentation is done via lisp indentation rules.
217 Not 'default-tab-width."
218 (lisp-indent-line)
219 (next-line))
220 ;; ==========================================================================
221 (defun newlisp-indent-and-move-back ()
222 (lisp-indent-line)
223 (previous-line))
224 ;; ==========================================================================
225 (defun newlisp-prev-opening-parens ()
226 (re-search-backward "("))
227 ;; ==========================================================================
228 (defun newlisp-next-opening-parens ()
229 (if (eq (char-after) 40)
230 (forward-char 1))
231 (re-search-forward "(")
232 (backward-char 1))
233 ;; ==========================================================================
234 (defun newlisp-sexp-start ()
235 "Move point to nearest opening parens"
236 (interactive)
237 (if
238 (not (eq (char-after) 40))
239 (re-search-backward "(")))
240 ;; ==========================================================================
241 (defun newlisp-sexp-end()
242 "Move point to nearest closing parens"
243 (interactive)
244 (re-search-forward ")"))
245 ;; ==========================================================================
246 ;; Inferior process functions and constants
247 ;; ==========================================================================
248 (defun newlisp-select-sexp ()
249 "Select the innermost sexp (closest to cursor)"
250 (interactive)
251 (newlisp-sexp-start)
252 (set-mark (point))
253 (forward-sexp))
254 ;; ==========================================================================
255 (defun newlisp-select-function ()
256 "Select enclosing function OR
257 previous function if cursor not inside of a function sexp.
258 Cursor moved to end of function."
259 (interactive)
260 (let ((found nil))
261 (cond ((newlisp-at-function-startp) (setq found t))
262 ((newlisp-previous-functionp) (setq found t)))
263 (cond
264 (found
265 (set-mark (point))
266 (forward-sexp))
267 (t (message "No enclosing or previous function to select")))))
268 ;; ==========================================================================
269 (defun newlisp-evaluate-function ()
270 "Evaluate the enclosing (or previous) function"
271 (interactive)
272 (save-excursion
273 (let ((found nil))
274 (cond ((newlisp-at-function-startp)
275 (setq found t))
276 ((newlisp-previous-functionp)
277 (setq found t)))
278 (cond (found
279 (forward-sexp)
280 (newlisp-evaluate-prev-sexp))
281 (t (message
282 "No enclosing or previous function to select for evaluation"))))))
283 ;; ==========================================================================
284 (defun newlisp-evaluate-buffer()
285 "Tells the inferior process to load the current buffer.
286 Uses the newlisp 'load command."
287 (interactive)
288 (process-send-string
289 newlisp-process-name
290 (concat "(load \"" (buffer-file-name) "\")\n")))
291 ;; ==========================================================================
292 ;; CONTRIB: fronter000
293 ;; Modified by Maintainer. Let form added.
294 ;; ==========================================================================
295 (defun newlisp-quote-comments (str)
296 "Quote comments for consistant evaluation."
297 (let ((idx 0))
298 (while (setq idx (string-match ";" str idx))
299 (store-substring str idx ?{)
300 (setq idx (string-match "\n" str idx))
301 (store-substring str idx ?})))
302 str)
303 ;; ==========================================================================
304 ;; CONTRIB: frontera000 provided 'newlisp-surround-cmds
305 ;; Maintainer: Wrapped code in 'let form
306 ;; Functionality: Cleaner interpreter window.
307 ;; ==========================================================================
308 (defun newlisp-evaluate-region (beg end)
309 "Send the current region to the inferior newlisp process, removing newlines."
310 (interactive "r")
311 (let ((str
312 (newlisp-surround-cmds
313 (buffer-substring-no-properties beg end))))
314 (process-send-string
315 newlisp-process-name str)))
316 ;; ==========================================================================
317 ;; CONTRIB: frontera000. Code evaluated, not displayed in interpreter window
318 ;; ==========================================================================
319 (defun newlisp-surround-cmds (str)
320 "Provide 'cmd directive for code"
321 (concat "\n[cmd]\n" str "\n[/cmd]\n"))
322 ;; ==========================================================================
323 (defun newlisp-evaluate-prev-sexp()
324 "Send the previous sexp to the inferior Scheme process.
325 Newlines removed."
326 (interactive)
327 (newlisp-evaluate-region
328 (save-excursion (backward-sexp) (point)) (point)))
329 ;; =====================================================================================
330 ;; Top-level Values
331 ;; =====================================================================================
332 (defconst newlisp-binary-name "newlisp" "Process executable")
333 ;; =====================================================================================
334 (defconst newlisp-process-name "newlisp" "Newlisp Process Name")
335 ;; =====================================================================================
336 (defconst newlisp-function-regexp
337 (regexp-opt '("define" "defun" "fn"))
338 "Newlisp function names")
339 ;; =====================================================================================
340 (defcustom newlisp-doc-buffer "*newlisp-doc-buffer*"
341 "Unique buffer name for newlisp docs"
342 :type 'string
343 :group 'newlisp)
344 ;; ==========================================================================
345 (defvar newlisp-help-buffers
346 `("*Help*" ,newlisp-doc-buffer)
347 "Can hold any buffer that can get in the way. newlisp-kill-help-buffers
348 uses this for cleanup.")
349 ;; ==========================================================================
350 (defcustom newlisp-comment-prefix ";;"
351 "*String used by \\[comment-region] to comment out a block of code."
352 :type 'string
353 :group 'newlisp)
354 ;; ==========================================================================
355 (defun newlisp-font-lock-fontify-buffer ()
356 "Just a wrapper for font-lock-fontify-buffer. Use liberally to refontify
357 multi-line strings. HINT: put cursor outside of string when using."
358 (interactive)
359 (font-lock-fontify-buffer))
360 ;; ==========================================================================
361 (defun newlisp-previous-functionp ()
362 "Look for the preceding function definition.
363 Move there and return t if found.
364 Reset to starting point and return nil if not found."
365 (interactive)
366 (let (res (start (point)))
367 (setq res
368 (re-search-backward
369 newlisp-function-begin-regexp nil 'move))
370 (cond
371 (res
372 (if (newlisp-at-function-startp)
373 (setq res t)
374 (goto-char start)
375 (setq res nil)))
376 (t
377 (goto-char start)
378 (setq res nil)))
379 res)
380 )
381 ;; ==========================================================================
382 (defun newlisp-next-functionp ()
383 "Look for next function definition.
384 Move there and return t if found.
385 Reset to starting point and return nil if not found."
386 (interactive)
387 (if (eq 40 (char-after)) (forward-char 1))
388 (let (res (start (point)))
389 (setq res
390 (re-search-forward newlisp-function-begin-regexp nil 'move))
391 (cond
392 (res
393 (re-search-backward "(")
394 (if (newlisp-at-function-startp)
395 (setq res t)
396 (goto-char start)
397 (setq res nil)))
398 (t (goto-char start) ;; go back to where we started
399 (setq res nil)))
400 res))
401 ;; ==========================================================================
402 (defun newlisp-previous-function()
403 "Moves point backwards to the beginning of the nearest function definition"
404 (interactive)
405 (let (res)
406 (setq res (newlisp-previous-functionp))
407 (if (not res)
408 (message "No previous function"))))
409 ;; ==========================================================================
410 (defun newlisp-next-function()
411 "Moves point backwards to the beginning of the nearest function definition"
412 (interactive)
413 (let (res)
414 (setq res (newlisp-next-functionp))
415 (if (not res)
416 (message "No function found while searching forward."))))
417 ;; ==========================================================================
418 (defun newlisp-comment-line ()
419 "Comment out line"
420 (interactive)
421 (save-excursion
422 (back-to-indentation)
423 (insert newlisp-comment-prefix)))
424 ;; ==========================================================================
425 (defun newlisp-uncomment-line ()
426 "Uncomment line"
427 (interactive)
428 (save-excursion
429 (back-to-indentation)
430 (while (eq (char-after) 59)
431 (delete-char 1))))
432 ;; ==========================================================================
433 (defun newlisp-comment-region (beg end &optional arg)
434 "comment out the region."
435 (interactive "r\nP")
436 (let ((comment-start newlisp-comment-prefix))
437 (comment-region beg end arg)))
438 ;; ==========================================================================
439 (defun newlisp-uncomment-region (beg end &optional arg)
440 "Uncomment region."
441 (interactive "r\nP")
442 (let ((comment-start newlisp-comment-prefix))
443 (comment-region beg end -1)))
444 ;; ===============================================================================================
445 ;; Inferior process
446 ;; ===============================================================================================
447 (defun newlisp-clear-comint-buffer ()
448 "Clear the Interpreter input/output window"
449 (interactive)
450 (newlisp-visit-interpreter)
451 (let (begin end)
452 (beginning-of-buffer)
453 (setq begin (point))
454 (end-of-buffer)
455 (setq end (point))
456 (delete-region begin end)
457 (other-window 1)))
458 ;; ===============================================================================================
459 (defun newlisp-show-interpreter()
460 "Start and/or show interpreter in other window.
461 Cursor stays at point."
462 (interactive)
463 (switch-to-buffer-other-window
464 (make-comint newlisp-process-name newlisp-binary-name))
465 (other-window -1))
466 ;; ===============================================================================================
467 (defun newlisp-visit-interpreter()
468 "Start and/or show interpreter in other window.
469 Then, put cursor in other window."
470 (interactive)
471 (switch-to-buffer-other-window
472 (make-comint newlisp-process-name newlisp-binary-name)))
473 ;; ==========================================================================
474 (defun newlisp-indent-line ()
475 "Set a line to proper lisp-style indentation.
476 Sometimes this means that a line may be `out'dented."
477 (interactive) (lisp-indent-line))
478 ;; ==========================================================================
479 (defun newlisp-indent-sexp()
480 "Set a sexp to proper lisp-style indentation.
481 Sometimes this means that a sexp may be `out'dented."
482 (interactive) (indent-sexp))
483 ;; ==========================================================================
484 (defun newlisp-nudge-region ()
485 "Indent region by space"
486 (interactive "r\nP")
487 (indent-rigidly beg end 1)
488 (exchange-point-and-mark))
489 ;; =====================================================================
490 (defun newlisp-tab-region (beg end &optional arg)
491 "Indent a region by a tab."
492 (interactive "r\nP")
493 (indent-rigidly beg end tab-width)
494 (exchange-point-and-mark))
495 ;; ==========================================================================
496 (defun newlisp-delete-sexp ()
497 "Delete outermost enclosing sexp."
498 (interactive)
499 (cond
500 ((eq (char-after) 40) ;; cursor on '('
501 (kill-sexp 1))
502 ((eq (char-after) 41) ;; cursor on ')'
503 (forward-char 1)
504 (backward-sexp)
505 (kill-sexp 1))
506 (t (newlisp-sexp-start) ;; find nearest preceding '('
507 (kill-sexp 1))))
508 ;; ==========================================================================
509 (defun newlisp-context-qualify ()
510 "Following convention for context, uppercase and add colon."
511 (interactive)
512 (if (not (bowp))
513 (backward-word 1))
514 (upcase-word 1)
515 (insert ":"))
516 ;; ==========================================================================
517 ;; CONTRIB: Jeff Ober - allows selection by list and evaluation by list like
518 ;; tuareg mode.
519 ;; ==========================================================================
520 (defun newlisp-list-open ()
521 "As with Emacs Lisp Mode, assumes the nearest opening paren at the first
522 position within a line is the root opening paren."
523 (interactive)
524 (if (not (bobp)) (re-search-backward "^(")))
525
526 (defun newlisp-list-close ()
527 "Finds the current list's closing paren."
528 (interactive)
529 (newlisp-sexp-start)
530 (forward-char 1)
531 (let ((openers 1) (closers 0))
532 (while (and (not (eobp)) (> openers closers))
533 (cond
534 ((eq (following-char) ?\() (incf openers))
535 ((eq (following-char) ?\)) (incf closers)))
536 (forward-char 1))))
537
538 (defun newlisp-select-list ()
539 "Selects the current list."
540 (interactive)
541 (beginning-of-line)
542 (forward-char 1)
543 (newlisp-list-open)
544 (set-mark (point))
545 (newlisp-list-close))
546
547 (defun newlisp-incremental-eval ()
548 "Evaluates the current list (rooted at the beginning of a line) and moves
549 on to the next (like Tuareg mode)."
550 (interactive)
551 (newlisp-select-list)
552 (let ((b (mark)) (e (point)))
553 (deactivate-mark)
554 (newlisp-evaluate-region b e)
555 (re-search-forward "(")
556 (backward-char 1)))
557 ;; ==========================================================================
558 (defvar newlisp-font-lock-keywords
559 `(,@scheme-font-lock-keywords ;; note: backquote and splice operator!
560 ;; add new keywords for highlighting in our sample face
561 (,(concat "\\<\\(" newlisp-keywords-regexp "\\)\\>") ;; builtin keywords + word boundaries
562 0 newlisp-font-lock-keywords-face) ;; removed 't as last argument
563 (,(concat "\\<\\(" newlisp-user-keywords-regexp "\\)\\>") ;; user keywords
564 0 newlisp-font-lock-user-keywords-face)
565 (,(concat ":\\(" newlisp-user-keywords-regexp "\\)\\>") ;; user keywords with ':' prefix
566 0 newlisp-font-lock-user-keywords-face)
567 (,(concat "\\<\\(" newlisp-function-names-regexp "\\)\\>") ;; function keywords + word boundaries
568 0 newlisp-font-lock-function-names-face t)
569 ;; Multi-line string highlighting. HINT: use ctrl-c f to refontify
570 ;; NOTE: emacs does not handle multi-line string well in this manner.
571 ;; (JB) suggests looking at how perl and AUCTex handle this.
572 ;("[^#]\\({[^{}]*}\\)" 0 'font-lock-string-face) ;; braces, {}
573 ("[^#]\\({[^{}]*}\\)" 0 font-lock-string-face t) ; long string
574 ("[^#]\\(\\[text\\][^{}]*\\[/text\\]\\)" 0 'font-lock-string-face t) ;; [text] [/text]
575 ("'[A-Za-z0-9\-_*0-9]*" 0 'newlisp-font-lock-quote-face)
576 ("\\(^\\|[^\$\\\]\\)#.*" 0 'font-lock-comment-face t) ;; ## comments
577 ("\\(^\\|[^\$\\\]\\);.*" 0 'font-lock-comment-face t) ;; `;;' comments
578 )
579 "List of newlisp keywords and faces.")
580 ;; ==========================================================================
581 ;; Construct a keymap for the mode.
582 ;; ==========================================================================
583 (defvar newlisp-mode-map
584 (let ((map (make-sparse-keymap))) ;; c-h make-sparse-keymap <RET>
585 ;; Here we may define any number of key sequences for our mode
586 ;; c-h define-key <RET>
587 (define-key map [(control c) (control b) (s)] 'newlisp-show-interpreter)
588 (define-key map [(control c) (control b) (v)] 'newlisp-visit-interpreter)
589 (define-key map [(control c) (control b) (c)] 'newlisp-clear-comint-buffer)
590 ; --------------------------------------------------------------
591 (define-key map [(control c) (control e) (b)] 'newlisp-evaluate-buffer)
592 (define-key map [(control c) (control e) (p)] 'newlisp-evaluate-prev-sexp)
593 (define-key map [(control c) (control e) (r)] 'newlisp-evaluate-region)
594 (define-key map [(control c) (control e) (f)] 'newlisp-evaluate-function)
595 ; -----------------------------------------------------------------------
596 (define-key map [(control c) (control i) (n)] 'newlisp-nudge-region)
597 (define-key map [(control c) (control i) (t)] 'newlisp-tab-region)
598 (define-key map [(control c) (control i) (l)] 'newlisp-indent-line)
599 (define-key map [(control c) (control i) (x)] 'newlisp-indent-sexp)
600 (define-key map [(control c) (control i) (d)] 'newlisp-delete-sexp)
601 (define-key map [(control c) (control i) (\;)] 'newlisp-context-qualify)
602 ; -----------------------------------------------------------------------
603 (define-key map [(control c) (control n)] 'newlisp-next-function)
604 (define-key map [(control c) (control p)] 'newlisp-previous-function)
605 (define-key map [(control c) (?\[)] 'newlisp-sexp-start)
606 (define-key map [(control c) (?\])] 'newlisp-sexp-end)
607 (define-key map [(control c) (control ?\[)] 'forward-sexp) ;; note: menu and help view will show C-c ESC
608 (define-key map [(control c) (control ?\])] 'backward-sexp)
609 ; -----------------------------------------------------------------------
610 (define-key map [(control c) (control s) (x)] 'newlisp-select-sexp)
611 (define-key map [(control c) (control s) (s)] 'newlisp-select-function)
612 (define-key map [(control c) (control c) (c)] 'newlisp-comment-region)
613 (define-key map [(control c) (control c) (\;)] 'newlisp-comment-line)
614 (define-key map [(control c) (control c) (control \;)] 'newlisp-uncomment-line)
615 (define-key map [(control c) (control c) (u)] 'newlisp-uncomment-region)
616 (define-key map [(control c) (control f)] 'newlisp-font-lock-fontify-buffer)
617 ; -----------------------------------------------------------------------
618 ; 2008-03-12 Jeff Ober: a few more simple shortcuts
619 ; -----------------------------------------------------------------------
620 (define-key map [(control x) (control e)] 'newlisp-incremental-eval)
621 ; -----------------------------------------------------------------------
622 map)
623 "Keymap for `newlisp-mode'.")
624 ;; ==========================================================================
625 ;; Define the menu using 'easy-menu-define for
626 ;; best compatibility for both forks.
627 ;; ==========================================================================
628 (easy-menu-define ;; c-h f easy-menu-define <RET>
629 newlisp-menu newlisp-mode-map "Newlisp Mode Menu"
630 '("Newlisp"
631 ["Show Interpreter" newlisp-show-interpreter]
632 ["Visit Interpreter" newlisp-visit-interpreter]
633 ["Clear Interpreter" newlisp-clear-comint-buffer]
634 ["Evaluate Buffer" newlisp-evaluate-buffer]
635 ["Evaluate Region" newlisp-evaluate-region]
636 ["Evaluate Prev Sexp" newlisp-evaluate-prev-sexp]
637 ["Evaluate Function" newlisp-evaluate-function]
638 "-" ;; seperator
639 ("Text Operations" ;; submenu
640 ["Indent Region by TAB" newlisp-tab-region]
641 ["Indent Region by SPACE" newlisp-nudge-region]
642 ["Indentation for Line" newlisp-indent-line]
643 ["Indent Sexp" newlisp-indent-sexp]
644 ["Delete Sexp" newlisp-delete-sexp]
645 ["Select Sexp" newlisp-select-sexp]
646 ["Context" newlisp-context-qualify]
647 )
648 "-" ;; seperator
649 ["Next function" newlisp-next-function]
650 ["Previous function" newlisp-previous-function]
651 ["Nearest Start of Sexp" newlisp-sexp-start]
652 ["Nearest End of Sexp" newlisp-sexp-end]
653 ["Forward Sexp" forward-sexp]
654 ["Backward Sexp" backward-sexp]
655 "-" ;; seperator
656 ["Select function" newlisp-select-function]
657 ["Select Sexp" newlisp-select-sexp]
658 ["Comment Out Region" newlisp-comment-region]
659 ["Comment Out Line" newlisp-comment-line]
660 ["Uncomment Region" newlisp-uncomment-region]
661 ["Uncomment Line" newlisp-uncomment-line]
662 ["Fontify Buffer" newlisp-font-lock-fontify-buffer]
663 ))
664 ;; ==========================================================================
665 (define-derived-mode newlisp-mode scheme-mode "newlisp"
666 "A major mode for Newlisp."
667 (easy-menu-add newlisp-menu) ;; install main menu
668 (imenu-add-menubar-index) ;; install imenu with title "Index"
669 (setq imenu-sort-function 'imenu--sort-by-name) ;; alternatively: 'imenu--sort-by-position
670 (setq auto-rescan t) ;; tell imenu to rescan every time it is used
671 (run-hooks 'newlisp-mode-hook)
672 (message "Load Newlisp Mode")
673 ;; Highly Recommended: c-h v font-lock-keywords <RET>
674 (set (make-local-variable 'font-lock-defaults)
675 (cons 'newlisp-font-lock-keywords
676 (or (cdr font-lock-defaults)
677 '(nil t ;; syntax table modifications follow: You may wish to use
678 ;; For help: C-h f modify-syntax-entry <RET>
679 ;; Bind non-alpha characters to the 'word' syntax class
680 ((?+ . "w") (?- . "w") (?* . "w") (?/ . "w")
681 (?. . "w") (?< . "w") (?> . "w") (?= . "w")
682 (?? . "w") (?$ . "w") (?% . "w") (?_ . "w")
683 ;(?& . "w") (?~ . "w") (?^ . "w") (?: . "w"))))))
684 (?& . "w") (?~ . "w") (?^ . "w") )))))
685 ;; NOTE: Emacs accepts a more compact approach.
686 ;; The cons-cell list approach used here is for XEmacs compatibility.
687 (define-key scheme-mode-map [menu-bar scheme] nil) ;; drop the scheme menu
688 )
689 ;;; newlisp.el ends here
Something went wrong with that request. Please try again.