Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 691 lines (682 sloc) 33.187 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"))
f099517 Added if-not keyword to list; fiddled with colors a bit, personal pref.
Nicholas E. May (on Enterprise) authored
120 (((class color) (background dark)) (:foreground "cyan")) ;; was yellow NEM
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
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"))
f099517 Added if-not keyword to list; fiddled with colors a bit, personal pref.
Nicholas E. May (on Enterprise) authored
140 (((class color) (background dark)) (:foreground "dark slate gray")) ;; NEM was yellow3
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
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"
f099517 Added if-not keyword to list; fiddled with colors a bit, personal pref.
Nicholas E. May (on Enterprise) authored
183 "get-int" "get-long" "get-string" "get-url" "global" "global?"
184 "if" "if-not" "ifft" "import"
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
185 "inc" "index" "int" "integer" "integer?" "intersect" "invert" "irr" "join" "lambda?"
186 "last" "legal?" "length" "let" "letex" "letn" "list" "list?" "load" "local" "log"
187 "lookup" "lower-case" "macro?" "main-args" "make-dir" "map" "mat" "match" "max"
188 "member" "min" "mod" "mul" "multiply" "name" "net-accept" "net-close" "net-connect"
189 "net-error" "net-eval" "net-listen" "net-local" "net-lookup" "net-peek" "net-peer"
190 "net-ping" "net-receive" "net-receive-from" "net-receive-udp" "net-select" "net-send"
191 "net-send-to" "net-send-udp" "net-service" "net-sessions" "new" "nil" "nil?" "normal"
192 "not" "now" "nper" "npv" "nth" "nth-set" "null?" "number?" "open" "or" "ostype"
193 "pack" "parse" "parse-date" "peek" "pipe" "pmt" "pop" "pop-assoc" "post-url" "pow"
194 "pretty-print" "primitive?" "print" "println" "prob-chi2" "prob-z" "process" "protected?"
195 "push" "put-url" "pv" "quote" "quote?" "rand" "random" "randomize" "read-buffer"
196 "read-char" "read-file" "read-key" "read-line" "real-path" "ref" "ref-all" "ref-set"
197 "regex" "remove-dir" "rename-file" "replace" "replace-assoc" "reset" "rest" "reverse"
198 "rotate" "round" "save" "search" "seed" "seek" "select" "semaphore" "sequence" "series"
199 "set" "set-assoc" "set-locale" "set-nth" "set-ref" "set-ref-all" "setq" "sgn" "share"
200 "signal" "silent" "sin" "sinh" "sleep" "slice" "sort" "source" "sqrt" "starts-with"
201 "string" "string?" "sub" "swap" "sym" "symbol?" "symbols" "sys-error" "sys-info"
202 "tan" "tanh" "throw" "throw-error" "time" "time-of-day" "timer" "title-case" "trace"
203 "trace-highlight" "transpose" "trim" "true" "true?" "unicode" "unify" "unique" "unless"
204 "unpack" "until" "upper-case" "utf8" "utf8len" "uuid" "wait-pid" "when" "while"
205 "write-buffer" "write-char" "write-file" "write-line" "xml-error" "xml-parse" "xml-type-tags"
206 "zero?" "|" "~"
207 )))
208 ;; ==========================================================================
209 (defconst
210 newlisp-user-keywords-regexp
211 (regexp-opt '( ;; c-h f regexp-opt <ret>
212 ;; for your own libraries
213 ;"aligned?" "even?" "ltrim" "ltrims" "parseint" "rtrim" "rtrims" "second" "third";; test
214 )))
215 ;; ==========================================================================
216 (defun newlisp-indent-and-move-next ()
217 "NOTE: Indentation is done via lisp indentation rules.
218 Not 'default-tab-width."
219 (lisp-indent-line)
220 (next-line))
221 ;; ==========================================================================
222 (defun newlisp-indent-and-move-back ()
223 (lisp-indent-line)
224 (previous-line))
225 ;; ==========================================================================
226 (defun newlisp-prev-opening-parens ()
227 (re-search-backward "("))
228 ;; ==========================================================================
229 (defun newlisp-next-opening-parens ()
230 (if (eq (char-after) 40)
231 (forward-char 1))
232 (re-search-forward "(")
233 (backward-char 1))
234 ;; ==========================================================================
235 (defun newlisp-sexp-start ()
236 "Move point to nearest opening parens"
237 (interactive)
238 (if
239 (not (eq (char-after) 40))
240 (re-search-backward "(")))
241 ;; ==========================================================================
242 (defun newlisp-sexp-end()
243 "Move point to nearest closing parens"
244 (interactive)
245 (re-search-forward ")"))
246 ;; ==========================================================================
247 ;; Inferior process functions and constants
248 ;; ==========================================================================
249 (defun newlisp-select-sexp ()
250 "Select the innermost sexp (closest to cursor)"
251 (interactive)
252 (newlisp-sexp-start)
253 (set-mark (point))
254 (forward-sexp))
255 ;; ==========================================================================
256 (defun newlisp-select-function ()
257 "Select enclosing function OR
258 previous function if cursor not inside of a function sexp.
259 Cursor moved to end of function."
260 (interactive)
261 (let ((found nil))
262 (cond ((newlisp-at-function-startp) (setq found t))
263 ((newlisp-previous-functionp) (setq found t)))
264 (cond
265 (found
266 (set-mark (point))
267 (forward-sexp))
268 (t (message "No enclosing or previous function to select")))))
269 ;; ==========================================================================
270 (defun newlisp-evaluate-function ()
271 "Evaluate the enclosing (or previous) function"
272 (interactive)
273 (save-excursion
274 (let ((found nil))
275 (cond ((newlisp-at-function-startp)
276 (setq found t))
277 ((newlisp-previous-functionp)
278 (setq found t)))
279 (cond (found
280 (forward-sexp)
281 (newlisp-evaluate-prev-sexp))
282 (t (message
283 "No enclosing or previous function to select for evaluation"))))))
284 ;; ==========================================================================
285 (defun newlisp-evaluate-buffer()
286 "Tells the inferior process to load the current buffer.
287 Uses the newlisp 'load command."
288 (interactive)
289 (process-send-string
290 newlisp-process-name
291 (concat "(load \"" (buffer-file-name) "\")\n")))
292 ;; ==========================================================================
293 ;; CONTRIB: fronter000
294 ;; Modified by Maintainer. Let form added.
295 ;; ==========================================================================
296 (defun newlisp-quote-comments (str)
297 "Quote comments for consistant evaluation."
298 (let ((idx 0))
299 (while (setq idx (string-match ";" str idx))
300 (store-substring str idx ?{)
301 (setq idx (string-match "\n" str idx))
302 (store-substring str idx ?})))
303 str)
304 ;; ==========================================================================
305 ;; CONTRIB: frontera000 provided 'newlisp-surround-cmds
306 ;; Maintainer: Wrapped code in 'let form
307 ;; Functionality: Cleaner interpreter window.
308 ;; ==========================================================================
309 (defun newlisp-evaluate-region (beg end)
310 "Send the current region to the inferior newlisp process, removing newlines."
311 (interactive "r")
312 (let ((str
313 (newlisp-surround-cmds
314 (buffer-substring-no-properties beg end))))
315 (process-send-string
316 newlisp-process-name str)))
317 ;; ==========================================================================
318 ;; CONTRIB: frontera000. Code evaluated, not displayed in interpreter window
319 ;; ==========================================================================
320 (defun newlisp-surround-cmds (str)
321 "Provide 'cmd directive for code"
322 (concat "\n[cmd]\n" str "\n[/cmd]\n"))
323 ;; ==========================================================================
324 (defun newlisp-evaluate-prev-sexp()
325 "Send the previous sexp to the inferior Scheme process.
326 Newlines removed."
327 (interactive)
328 (newlisp-evaluate-region
329 (save-excursion (backward-sexp) (point)) (point)))
330 ;; =====================================================================================
331 ;; Top-level Values
332 ;; =====================================================================================
333 (defconst newlisp-binary-name "newlisp" "Process executable")
334 ;; =====================================================================================
335 (defconst newlisp-process-name "newlisp" "Newlisp Process Name")
336 ;; =====================================================================================
337 (defconst newlisp-function-regexp
338 (regexp-opt '("define" "defun" "fn"))
339 "Newlisp function names")
340 ;; =====================================================================================
341 (defcustom newlisp-doc-buffer "*newlisp-doc-buffer*"
342 "Unique buffer name for newlisp docs"
343 :type 'string
344 :group 'newlisp)
345 ;; ==========================================================================
346 (defvar newlisp-help-buffers
347 `("*Help*" ,newlisp-doc-buffer)
348 "Can hold any buffer that can get in the way. newlisp-kill-help-buffers
349 uses this for cleanup.")
350 ;; ==========================================================================
351 (defcustom newlisp-comment-prefix ";;"
352 "*String used by \\[comment-region] to comment out a block of code."
353 :type 'string
354 :group 'newlisp)
355 ;; ==========================================================================
356 (defun newlisp-font-lock-fontify-buffer ()
357 "Just a wrapper for font-lock-fontify-buffer. Use liberally to refontify
358 multi-line strings. HINT: put cursor outside of string when using."
359 (interactive)
360 (font-lock-fontify-buffer))
361 ;; ==========================================================================
362 (defun newlisp-previous-functionp ()
363 "Look for the preceding function definition.
364 Move there and return t if found.
365 Reset to starting point and return nil if not found."
366 (interactive)
367 (let (res (start (point)))
368 (setq res
369 (re-search-backward
370 newlisp-function-begin-regexp nil 'move))
371 (cond
372 (res
373 (if (newlisp-at-function-startp)
374 (setq res t)
375 (goto-char start)
376 (setq res nil)))
377 (t
378 (goto-char start)
379 (setq res nil)))
380 res)
381 )
382 ;; ==========================================================================
383 (defun newlisp-next-functionp ()
384 "Look for next function definition.
385 Move there and return t if found.
386 Reset to starting point and return nil if not found."
387 (interactive)
388 (if (eq 40 (char-after)) (forward-char 1))
389 (let (res (start (point)))
390 (setq res
391 (re-search-forward newlisp-function-begin-regexp nil 'move))
392 (cond
393 (res
394 (re-search-backward "(")
395 (if (newlisp-at-function-startp)
396 (setq res t)
397 (goto-char start)
398 (setq res nil)))
399 (t (goto-char start) ;; go back to where we started
400 (setq res nil)))
401 res))
402 ;; ==========================================================================
403 (defun newlisp-previous-function()
404 "Moves point backwards to the beginning of the nearest function definition"
405 (interactive)
406 (let (res)
407 (setq res (newlisp-previous-functionp))
408 (if (not res)
409 (message "No previous function"))))
410 ;; ==========================================================================
411 (defun newlisp-next-function()
412 "Moves point backwards to the beginning of the nearest function definition"
413 (interactive)
414 (let (res)
415 (setq res (newlisp-next-functionp))
416 (if (not res)
417 (message "No function found while searching forward."))))
418 ;; ==========================================================================
419 (defun newlisp-comment-line ()
420 "Comment out line"
421 (interactive)
422 (save-excursion
423 (back-to-indentation)
424 (insert newlisp-comment-prefix)))
425 ;; ==========================================================================
426 (defun newlisp-uncomment-line ()
427 "Uncomment line"
428 (interactive)
429 (save-excursion
430 (back-to-indentation)
431 (while (eq (char-after) 59)
432 (delete-char 1))))
433 ;; ==========================================================================
434 (defun newlisp-comment-region (beg end &optional arg)
435 "comment out the region."
436 (interactive "r\nP")
437 (let ((comment-start newlisp-comment-prefix))
438 (comment-region beg end arg)))
439 ;; ==========================================================================
440 (defun newlisp-uncomment-region (beg end &optional arg)
441 "Uncomment region."
442 (interactive "r\nP")
443 (let ((comment-start newlisp-comment-prefix))
444 (comment-region beg end -1)))
445 ;; ===============================================================================================
446 ;; Inferior process
447 ;; ===============================================================================================
448 (defun newlisp-clear-comint-buffer ()
449 "Clear the Interpreter input/output window"
450 (interactive)
451 (newlisp-visit-interpreter)
452 (let (begin end)
453 (beginning-of-buffer)
454 (setq begin (point))
455 (end-of-buffer)
456 (setq end (point))
457 (delete-region begin end)
458 (other-window 1)))
459 ;; ===============================================================================================
460 (defun newlisp-show-interpreter()
461 "Start and/or show interpreter in other window.
462 Cursor stays at point."
463 (interactive)
464 (switch-to-buffer-other-window
465 (make-comint newlisp-process-name newlisp-binary-name))
466 (other-window -1))
467 ;; ===============================================================================================
468 (defun newlisp-visit-interpreter()
469 "Start and/or show interpreter in other window.
470 Then, put cursor in other window."
471 (interactive)
472 (switch-to-buffer-other-window
473 (make-comint newlisp-process-name newlisp-binary-name)))
474 ;; ==========================================================================
475 (defun newlisp-indent-line ()
476 "Set a line to proper lisp-style indentation.
477 Sometimes this means that a line may be `out'dented."
478 (interactive) (lisp-indent-line))
479 ;; ==========================================================================
480 (defun newlisp-indent-sexp()
481 "Set a sexp to proper lisp-style indentation.
482 Sometimes this means that a sexp may be `out'dented."
483 (interactive) (indent-sexp))
484 ;; ==========================================================================
485 (defun newlisp-nudge-region ()
486 "Indent region by space"
487 (interactive "r\nP")
488 (indent-rigidly beg end 1)
489 (exchange-point-and-mark))
490 ;; =====================================================================
491 (defun newlisp-tab-region (beg end &optional arg)
492 "Indent a region by a tab."
493 (interactive "r\nP")
494 (indent-rigidly beg end tab-width)
495 (exchange-point-and-mark))
496 ;; ==========================================================================
497 (defun newlisp-delete-sexp ()
498 "Delete outermost enclosing sexp."
499 (interactive)
500 (cond
501 ((eq (char-after) 40) ;; cursor on '('
502 (kill-sexp 1))
503 ((eq (char-after) 41) ;; cursor on ')'
504 (forward-char 1)
505 (backward-sexp)
506 (kill-sexp 1))
507 (t (newlisp-sexp-start) ;; find nearest preceding '('
508 (kill-sexp 1))))
509 ;; ==========================================================================
510 (defun newlisp-context-qualify ()
511 "Following convention for context, uppercase and add colon."
512 (interactive)
513 (if (not (bowp))
514 (backward-word 1))
515 (upcase-word 1)
516 (insert ":"))
517 ;; ==========================================================================
518 ;; CONTRIB: Jeff Ober - allows selection by list and evaluation by list like
519 ;; tuareg mode.
520 ;; ==========================================================================
521 (defun newlisp-list-open ()
522 "As with Emacs Lisp Mode, assumes the nearest opening paren at the first
523 position within a line is the root opening paren."
524 (interactive)
525 (if (not (bobp)) (re-search-backward "^(")))
526
527 (defun newlisp-list-close ()
528 "Finds the current list's closing paren."
529 (interactive)
530 (newlisp-sexp-start)
531 (forward-char 1)
532 (let ((openers 1) (closers 0))
533 (while (and (not (eobp)) (> openers closers))
534 (cond
ff0b8a1 Fixed problem in newlisp.el with incf not being found so C-x C-e works o...
Nicholas E. May (on Enterprise) authored
535 ((eq (following-char) ?\() (setq openers (+ 1 openers)))
536 ((eq (following-char) ?\)) (setq closers (+ 1 closers))))
837fb6c first commit; was stolen from somewhere on the web as-is
Nicholas E. May (on Enterprise) authored
537 (forward-char 1))))
538
539 (defun newlisp-select-list ()
540 "Selects the current list."
541 (interactive)
542 (beginning-of-line)
543 (forward-char 1)
544 (newlisp-list-open)
545 (set-mark (point))
546 (newlisp-list-close))
547
548 (defun newlisp-incremental-eval ()
549 "Evaluates the current list (rooted at the beginning of a line) and moves
550 on to the next (like Tuareg mode)."
551 (interactive)
552 (newlisp-select-list)
553 (let ((b (mark)) (e (point)))
554 (deactivate-mark)
555 (newlisp-evaluate-region b e)
556 (re-search-forward "(")
557 (backward-char 1)))
558 ;; ==========================================================================
559 (defvar newlisp-font-lock-keywords
560 `(,@scheme-font-lock-keywords ;; note: backquote and splice operator!
561 ;; add new keywords for highlighting in our sample face
562 (,(concat "\\<\\(" newlisp-keywords-regexp "\\)\\>") ;; builtin keywords + word boundaries
563 0 newlisp-font-lock-keywords-face) ;; removed 't as last argument
564 (,(concat "\\<\\(" newlisp-user-keywords-regexp "\\)\\>") ;; user keywords
565 0 newlisp-font-lock-user-keywords-face)
566 (,(concat ":\\(" newlisp-user-keywords-regexp "\\)\\>") ;; user keywords with ':' prefix
567 0 newlisp-font-lock-user-keywords-face)
568 (,(concat "\\<\\(" newlisp-function-names-regexp "\\)\\>") ;; function keywords + word boundaries
569 0 newlisp-font-lock-function-names-face t)
570 ;; Multi-line string highlighting. HINT: use ctrl-c f to refontify
571 ;; NOTE: emacs does not handle multi-line string well in this manner.
572 ;; (JB) suggests looking at how perl and AUCTex handle this.
573 ;("[^#]\\({[^{}]*}\\)" 0 'font-lock-string-face) ;; braces, {}
574 ("[^#]\\({[^{}]*}\\)" 0 font-lock-string-face t) ; long string
575 ("[^#]\\(\\[text\\][^{}]*\\[/text\\]\\)" 0 'font-lock-string-face t) ;; [text] [/text]
576 ("'[A-Za-z0-9\-_*0-9]*" 0 'newlisp-font-lock-quote-face)
577 ("\\(^\\|[^\$\\\]\\)#.*" 0 'font-lock-comment-face t) ;; ## comments
578 ("\\(^\\|[^\$\\\]\\);.*" 0 'font-lock-comment-face t) ;; `;;' comments
579 )
580 "List of newlisp keywords and faces.")
581 ;; ==========================================================================
582 ;; Construct a keymap for the mode.
583 ;; ==========================================================================
584 (defvar newlisp-mode-map
585 (let ((map (make-sparse-keymap))) ;; c-h make-sparse-keymap <RET>
586 ;; Here we may define any number of key sequences for our mode
587 ;; c-h define-key <RET>
588 (define-key map [(control c) (control b) (s)] 'newlisp-show-interpreter)
589 (define-key map [(control c) (control b) (v)] 'newlisp-visit-interpreter)
590 (define-key map [(control c) (control b) (c)] 'newlisp-clear-comint-buffer)
591 ; --------------------------------------------------------------
592 (define-key map [(control c) (control e) (b)] 'newlisp-evaluate-buffer)
593 (define-key map [(control c) (control e) (p)] 'newlisp-evaluate-prev-sexp)
594 (define-key map [(control c) (control e) (r)] 'newlisp-evaluate-region)
595 (define-key map [(control c) (control e) (f)] 'newlisp-evaluate-function)
596 ; -----------------------------------------------------------------------
597 (define-key map [(control c) (control i) (n)] 'newlisp-nudge-region)
598 (define-key map [(control c) (control i) (t)] 'newlisp-tab-region)
599 (define-key map [(control c) (control i) (l)] 'newlisp-indent-line)
600 (define-key map [(control c) (control i) (x)] 'newlisp-indent-sexp)
601 (define-key map [(control c) (control i) (d)] 'newlisp-delete-sexp)
602 (define-key map [(control c) (control i) (\;)] 'newlisp-context-qualify)
603 ; -----------------------------------------------------------------------
604 (define-key map [(control c) (control n)] 'newlisp-next-function)
605 (define-key map [(control c) (control p)] 'newlisp-previous-function)
606 (define-key map [(control c) (?\[)] 'newlisp-sexp-start)
607 (define-key map [(control c) (?\])] 'newlisp-sexp-end)
608 (define-key map [(control c) (control ?\[)] 'forward-sexp) ;; note: menu and help view will show C-c ESC
609 (define-key map [(control c) (control ?\])] 'backward-sexp)
610 ; -----------------------------------------------------------------------
611 (define-key map [(control c) (control s) (x)] 'newlisp-select-sexp)
612 (define-key map [(control c) (control s) (s)] 'newlisp-select-function)
613 (define-key map [(control c) (control c) (c)] 'newlisp-comment-region)
614 (define-key map [(control c) (control c) (\;)] 'newlisp-comment-line)
615 (define-key map [(control c) (control c) (control \;)] 'newlisp-uncomment-line)
616 (define-key map [(control c) (control c) (u)] 'newlisp-uncomment-region)
617 (define-key map [(control c) (control f)] 'newlisp-font-lock-fontify-buffer)
618 ; -----------------------------------------------------------------------
619 ; 2008-03-12 Jeff Ober: a few more simple shortcuts
620 ; -----------------------------------------------------------------------
621 (define-key map [(control x) (control e)] 'newlisp-incremental-eval)
622 ; -----------------------------------------------------------------------
623 map)
624 "Keymap for `newlisp-mode'.")
625 ;; ==========================================================================
626 ;; Define the menu using 'easy-menu-define for
627 ;; best compatibility for both forks.
628 ;; ==========================================================================
629 (easy-menu-define ;; c-h f easy-menu-define <RET>
630 newlisp-menu newlisp-mode-map "Newlisp Mode Menu"
631 '("Newlisp"
632 ["Show Interpreter" newlisp-show-interpreter]
633 ["Visit Interpreter" newlisp-visit-interpreter]
634 ["Clear Interpreter" newlisp-clear-comint-buffer]
635 ["Evaluate Buffer" newlisp-evaluate-buffer]
636 ["Evaluate Region" newlisp-evaluate-region]
637 ["Evaluate Prev Sexp" newlisp-evaluate-prev-sexp]
638 ["Evaluate Function" newlisp-evaluate-function]
639 "-" ;; seperator
640 ("Text Operations" ;; submenu
641 ["Indent Region by TAB" newlisp-tab-region]
642 ["Indent Region by SPACE" newlisp-nudge-region]
643 ["Indentation for Line" newlisp-indent-line]
644 ["Indent Sexp" newlisp-indent-sexp]
645 ["Delete Sexp" newlisp-delete-sexp]
646 ["Select Sexp" newlisp-select-sexp]
647 ["Context" newlisp-context-qualify]
648 )
649 "-" ;; seperator
650 ["Next function" newlisp-next-function]
651 ["Previous function" newlisp-previous-function]
652 ["Nearest Start of Sexp" newlisp-sexp-start]
653 ["Nearest End of Sexp" newlisp-sexp-end]
654 ["Forward Sexp" forward-sexp]
655 ["Backward Sexp" backward-sexp]
656 "-" ;; seperator
657 ["Select function" newlisp-select-function]
658 ["Select Sexp" newlisp-select-sexp]
659 ["Comment Out Region" newlisp-comment-region]
660 ["Comment Out Line" newlisp-comment-line]
661 ["Uncomment Region" newlisp-uncomment-region]
662 ["Uncomment Line" newlisp-uncomment-line]
663 ["Fontify Buffer" newlisp-font-lock-fontify-buffer]
664 ))
665 ;; ==========================================================================
666 (define-derived-mode newlisp-mode scheme-mode "newlisp"
667 "A major mode for Newlisp."
668 (easy-menu-add newlisp-menu) ;; install main menu
669 (imenu-add-menubar-index) ;; install imenu with title "Index"
670 (setq imenu-sort-function 'imenu--sort-by-name) ;; alternatively: 'imenu--sort-by-position
671 (setq auto-rescan t) ;; tell imenu to rescan every time it is used
672 (run-hooks 'newlisp-mode-hook)
673 (message "Load Newlisp Mode")
674 ;; Highly Recommended: c-h v font-lock-keywords <RET>
675 (set (make-local-variable 'font-lock-defaults)
676 (cons 'newlisp-font-lock-keywords
677 (or (cdr font-lock-defaults)
678 '(nil t ;; syntax table modifications follow: You may wish to use
679 ;; For help: C-h f modify-syntax-entry <RET>
680 ;; Bind non-alpha characters to the 'word' syntax class
681 ((?+ . "w") (?- . "w") (?* . "w") (?/ . "w")
682 (?. . "w") (?< . "w") (?> . "w") (?= . "w")
683 (?? . "w") (?$ . "w") (?% . "w") (?_ . "w")
684 ;(?& . "w") (?~ . "w") (?^ . "w") (?: . "w"))))))
685 (?& . "w") (?~ . "w") (?^ . "w") )))))
686 ;; NOTE: Emacs accepts a more compact approach.
687 ;; The cons-cell list approach used here is for XEmacs compatibility.
688 (define-key scheme-mode-map [menu-bar scheme] nil) ;; drop the scheme menu
689 )
690 ;;; newlisp.el ends here
Something went wrong with that request. Please try again.