Mercurial > hg > xemacs-beta

comparison lisp/lisp-mode.el @ 284:558f606b08ae r21-0b40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents 7df0dd720c89
children 57709be46d1b
comparison
equal deleted inserted replaced
283:fa3d41851a08 284:558f606b08ae
39 (defgroup lisp nil 39 (defgroup lisp nil
40 "Lisp support, including Emacs Lisp." 40 "Lisp support, including Emacs Lisp."
41 :group 'languages 41 :group 'languages
42 :group 'development) 42 :group 'development)
43 43
44 (defvar lisp-mode-syntax-table nil "") 44 (defvar lisp-mode-syntax-table nil)
45 (defvar emacs-lisp-mode-syntax-table nil "") 45 (defvar emacs-lisp-mode-syntax-table nil)
46 (defvar lisp-mode-abbrev-table nil "") 46 (defvar lisp-mode-abbrev-table nil)
47 47
48 ;; XEmacs change 48 ;; XEmacs change
49 (defvar lisp-interaction-mode-popup-menu nil) 49 (defvar lisp-interaction-mode-popup-menu nil)
50 (defvar lisp-interaction-mode-popup-menu-1 50 (defvar lisp-interaction-mode-popup-menu-1
51 (purecopy '("Lisp-Interaction" 51 (purecopy '("Lisp-Interaction"
114 (while (< i 128) 114 (while (< i 128)
115 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) 115 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table)
116 (setq i (1+ i))) 116 (setq i (1+ i)))
117 (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table) 117 (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table)
118 (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table) 118 (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table)
119 (modify-syntax-entry ?\f " " emacs-lisp-mode-syntax-table)
119 (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table) 120 (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table)
120 ;; Give CR the same syntax as newline, for selective-display. 121 ;; Give CR the same syntax as newline, for selective-display.
121 (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table) 122 (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table)
122 ;; XEmacs change
123 ;; Treat ^L as whitespace.
124 (modify-syntax-entry ?\f " " emacs-lisp-mode-syntax-table)
125 (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table) 123 (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table)
126 (modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table) 124 (modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table)
127 (modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table) 125 (modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table)
128 (modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table) 126 (modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table)
129 ;; Used to be singlequote; changed for flonums. 127 ;; Used to be singlequote; changed for flonums.
153 ;; else, old style 151 ;; else, old style
154 (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table)))) 152 (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table))))
155 153
156 (define-abbrev-table 'lisp-mode-abbrev-table ()) 154 (define-abbrev-table 'lisp-mode-abbrev-table ())
157 155
158 ;(defvar lisp-imenu-generic-expression 156 (defvar lisp-imenu-generic-expression
159 ; '( 157 '(
160 ; (nil 158 (nil
161 ; "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) 159 "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)
162 ; ("Variables" 160 ("Variables"
163 ; "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2) 161 "^\\s-*(def\\(var\\|const\\|custom\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)
164 ; ("Types" 162 ("Types"
165 ; "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 163 "^\\s-*(def\\(group\\|type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)"
166 ; 2)) 164 2))
167 ; 165
168 ; "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") 166 "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
169 167
170 (defun lisp-mode-variables (lisp-syntax) 168 (defun lisp-mode-variables (lisp-syntax)
171 (cond (lisp-syntax 169 (cond (lisp-syntax
172 (set-syntax-table lisp-mode-syntax-table))) 170 (set-syntax-table lisp-mode-syntax-table)))
173 (setq local-abbrev-table lisp-mode-abbrev-table) 171 (setq local-abbrev-table lisp-mode-abbrev-table)
202 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") 200 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
203 (make-local-variable 'comment-column) 201 (make-local-variable 'comment-column)
204 (setq comment-column 40) 202 (setq comment-column 40)
205 (make-local-variable 'comment-indent-function) 203 (make-local-variable 'comment-indent-function)
206 (setq comment-indent-function 'lisp-comment-indent) 204 (setq comment-indent-function 'lisp-comment-indent)
207 ;; XEmacs changes 205 ;; XEmacs change
208 ; (make-local-variable 'imenu-generic-expression)
209 ; (setq imenu-generic-expression lisp-imenu-generic-expression)
210 (set (make-local-variable 'dabbrev-case-fold-search) nil) 206 (set (make-local-variable 'dabbrev-case-fold-search) nil)
211 (set (make-local-variable 'dabbrev-case-replace) nil) 207 (set (make-local-variable 'dabbrev-case-replace) nil)
212 ) 208 (make-local-variable 'imenu-generic-expression)
213 209 (setq imenu-generic-expression lisp-imenu-generic-expression))
214 210
215 (defvar shared-lisp-mode-map () 211 (defvar shared-lisp-mode-map ()
216 "Keymap for commands shared by all sorts of Lisp modes.") 212 "Keymap for commands shared by all sorts of Lisp modes.")
217 213
218 (if shared-lisp-mode-map 214 (if shared-lisp-mode-map
402 :group 'lisp) 398 :group 'lisp)
403 399
404 (defun eval-interactive (expr) 400 (defun eval-interactive (expr)
405 "Like `eval' except that it transforms defvars to defconsts. 401 "Like `eval' except that it transforms defvars to defconsts.
406 The evaluation of defcustom forms is forced." 402 The evaluation of defcustom forms is forced."
407 (cond ((and (consp expr) 403 (cond ((and (eq (car-safe expr) 'defvar)
408 (eq (car expr) 'defvar)
409 (> (length expr) 2)) 404 (> (length expr) 2))
410 (eval (cons 'defconst (cdr expr))) 405 (eval (cons 'defconst (cdr expr)))
411 (and eval-interactive-verbose 406 (when eval-interactive-verbose
412 (message "defvar treated as defconst")) 407 (message "defvar treated as defconst")
413 (sit-for 1) 408 (sit-for 1)
414 (message "") 409 (message ""))
415 (nth 1 expr)) 410 (nth 1 expr))
416 ((and (consp expr) 411 ((and (eq (car-safe expr) 'defcustom)
417 (eq (car expr) 'defcustom)
418 (> (length expr) 2) 412 (> (length expr) 2)
419 (default-boundp (nth 1 expr))) 413 (default-boundp (nth 1 expr)))
420 ;; Force variable to be bound 414 ;; Force variable to be bound
415 ;; #### defcustom might specify a different :set method.
421 (set-default (nth 1 expr) (eval (nth 2 expr))) 416 (set-default (nth 1 expr) (eval (nth 2 expr)))
422 ;; And evaluate the defcustom 417 ;; And evaluate the defcustom
423 (eval expr) 418 (eval expr)
424 (and eval-interactive-verbose 419 (when eval-interactive-verbose
425 (message "defcustom evaluation forced")) 420 (message "defcustom evaluation forced")
426 (sit-for 1) 421 (sit-for 1)
427 (message "") 422 (message ""))
428 (nth 1 expr)) 423 (nth 1 expr))
429 (t 424 (t
430 (eval expr)))) 425 (eval expr))))
431 426
432 ;; XEmacs change, based on Bob Weiner suggestion 427 ;; XEmacs change, based on Bob Weiner suggestion
433 (defun eval-last-sexp (eval-last-sexp-arg-internal) ;dynamic scoping wonderment 428 (defun eval-last-sexp (eval-last-sexp-arg-internal) ;dynamic scoping wonderment
434 "Evaluate sexp before point; print value in minibuffer. 429 "Evaluate sexp before point; print value in minibuffer.
435 With argument, print output into current buffer." 430 With argument, print output into current buffer."
436 (interactive "P") 431 (interactive "P")
437 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) 432 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
438 (opoint (point))) 433 (opoint (point))
439 (prin1 (let ((stab (syntax-table)) 434 ignore-quotes)
440 expr) 435 (prin1 (eval-interactive
441 (eval-interactive 436 (letf (((syntax-table) emacs-lisp-mode-syntax-table))
442 (unwind-protect 437 (save-excursion
443 (save-excursion 438 ;; If this sexp appears to be enclosed in `...' then
444 (set-syntax-table emacs-lisp-mode-syntax-table) 439 ;; ignore the surrounding quotes.
445 (forward-sexp -1) 440 (setq ignore-quotes (or (eq (char-after) ?\')
446 (save-restriction 441 (eq (char-before) ?\')))
447 (narrow-to-region (point-min) opoint) 442 (forward-sexp -1)
448 (setq expr (read (current-buffer))) 443 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
449 (if (and (consp expr) 444 ;; `variable' so that the value is returned, not the
450 (eq (car expr) 'interactive)) 445 ;; name.
451 (list 'quote 446 (if (and ignore-quotes
452 (call-interactively 447 (eq (char-after) ?\`))
453 (eval (` (lambda (&rest args) 448 (forward-char))
454 (, expr) args))))) 449 (save-restriction
455 expr))) 450 (narrow-to-region (point-min) opoint)
456 (set-syntax-table stab))))))) 451 (let ((expr (read (current-buffer))))
452 (if (eq (car-safe expr) 'interactive)
453 ;; If it's an (interactive ...) form, it's
454 ;; more useful to show how an interactive call
455 ;; would use it.
456 `(call-interactively
457 (lambda (&rest args)
458 ,expr args))
459 expr)))))))))
457 460
458 (defun eval-defun (eval-defun-arg-internal) 461 (defun eval-defun (eval-defun-arg-internal)
459 "Evaluate defun that point is in or before. 462 "Evaluate defun that point is in or before.
460 Print value in minibuffer. 463 Print value in minibuffer.
461 With argument, insert value in current buffer after the defun." 464 With argument, insert value in current buffer after the defun."
469 472
470 (defun lisp-comment-indent () 473 (defun lisp-comment-indent ()
471 (if (looking-at "\\s<\\s<\\s<") 474 (if (looking-at "\\s<\\s<\\s<")
472 (current-column) 475 (current-column)
473 (if (looking-at "\\s<\\s<") 476 (if (looking-at "\\s<\\s<")
477 ;; #### FSF has:
478 ;; (let ((tem (or (calculate-lisp-indent) (current-column)))) ...
474 (let ((tem (calculate-lisp-indent))) 479 (let ((tem (calculate-lisp-indent)))
475 (if (listp tem) (car tem) tem)) 480 (if (listp tem) (car tem) tem))
476 (skip-chars-backward " \t") 481 (skip-chars-backward " \t")
477 (max (if (bolp) 0 (1+ (current-column))) 482 (max (if (bolp) 0 (1+ (current-column)))
478 comment-column)))) 483 comment-column))))
489 (if (and block-comment-start 494 (if (and block-comment-start
490 (save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))) 495 (save-excursion (beginning-of-line) (looking-at "^[ \t]*$")))
491 (insert block-comment-start)) 496 (insert block-comment-start))
492 (indent-for-comment)) 497 (indent-for-comment))
493 498
494 (defconst lisp-indent-offset nil "") 499 (defvar lisp-indent-offset nil)
495 (defconst lisp-indent-function 'lisp-indent-function "") 500 (defvar lisp-indent-function 'lisp-indent-function)
496 501
497 (defun lisp-indent-line (&optional whole-exp) 502 (defun lisp-indent-line (&optional whole-exp)
498 "Indent current line as Lisp code. 503 "Indent current line as Lisp code.
499 With argument, indent any additional lines of the same expression 504 With argument, indent any additional lines of the same expression
500 rigidly along with this one." 505 rigidly along with this one."
675 (lisp-indent-specform method state 680 (lisp-indent-specform method state
676 indent-point normal-indent)) 681 indent-point normal-indent))
677 (method 682 (method
678 (funcall method state indent-point))))))) 683 (funcall method state indent-point)))))))
679 684
680 (defconst lisp-body-indent 2 685 (defvar lisp-body-indent 2
681 "Number of columns to indent the second line of a `(def...)' form.") 686 "Number of columns to indent the second line of a `(def...)' form.")
682 687
683 (defun lisp-indent-specform (count state indent-point normal-indent) 688 (defun lisp-indent-specform (count state indent-point normal-indent)
684 (let ((containing-form-start (elt state 1)) 689 (let ((containing-form-start (elt state 1))
685 (i count) 690 (i count)
744 (put 'prog1 'lisp-indent-function 1) 749 (put 'prog1 'lisp-indent-function 1)
745 (put 'prog2 'lisp-indent-function 2) 750 (put 'prog2 'lisp-indent-function 2)
746 (put 'save-excursion 'lisp-indent-function 0) 751 (put 'save-excursion 'lisp-indent-function 0)
747 (put 'save-window-excursion 'lisp-indent-function 0) 752 (put 'save-window-excursion 'lisp-indent-function 0)
748 (put 'save-selected-window 'lisp-indent-function 0) 753 (put 'save-selected-window 'lisp-indent-function 0)
754 (put 'save-selected-frame 'lisp-indent-function 0)
755 (put 'with-selected-frame 'lisp-indent-function 1)
749 (put 'save-restriction 'lisp-indent-function 0) 756 (put 'save-restriction 'lisp-indent-function 0)
750 (put 'save-match-data 'lisp-indent-function 0) 757 (put 'save-match-data 'lisp-indent-function 0)
751 (put 'let 'lisp-indent-function 1) 758 (put 'let 'lisp-indent-function 1)
752 (put 'let* 'lisp-indent-function 1) 759 (put 'let* 'lisp-indent-function 1)
753 (put 'while 'lisp-indent-function 1) 760 (put 'while 'lisp-indent-function 1)
760 (put 'with-current-buffer 'lisp-indent-function 1) 767 (put 'with-current-buffer 'lisp-indent-function 1)
761 (put 'with-temp-file 'lisp-indent-function 1) 768 (put 'with-temp-file 'lisp-indent-function 1)
762 (put 'with-temp-buffer 'lisp-indent-function 0) 769 (put 'with-temp-buffer 'lisp-indent-function 0)
763 (put 'with-output-to-string 'lisp-indent-function 0) 770 (put 'with-output-to-string 'lisp-indent-function 0)
764 (put 'with-output-to-temp-buffer 'lisp-indent-function 1) 771 (put 'with-output-to-temp-buffer 'lisp-indent-function 1)
772 (put 'eval-after-load 'lisp-indent-function 1)
765 (put 'display-message 'lisp-indent-function 1) 773 (put 'display-message 'lisp-indent-function 1)
766 (put 'display-warning 'lisp-indent-function 1) 774 (put 'display-warning 'lisp-indent-function 1)
767 (put 'lmessage 'lisp-indent-function 2) 775 (put 'lmessage 'lisp-indent-function 2)
768 (put 'lwarn 'lisp-indent-function 2) 776 (put 'lwarn 'lisp-indent-function 2)
769 (put 'global-set-key 'lisp-indent-function 1) 777 (put 'global-set-key 'lisp-indent-function 1)
772 "Indent each line of the list starting just after point. 780 "Indent each line of the list starting just after point.
773 If optional arg ENDPOS is given, indent each line, stopping when 781 If optional arg ENDPOS is given, indent each line, stopping when
774 ENDPOS is encountered." 782 ENDPOS is encountered."
775 (interactive) 783 (interactive)
776 (let ((indent-stack (list nil)) 784 (let ((indent-stack (list nil))
777 (next-depth 0) 785 (next-depth 0)
778 ;; If ENDPOS is non-nil, use nil as STARTING-POINT 786 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
779 ;; so that calculate-lisp-indent will find the beginning of 787 ;; so that calculate-lisp-indent will find the beginning of
780 ;; the defun we are in. 788 ;; the defun we are in.
781 ;; If ENDPOS is nil, it is safe not to scan before point 789 ;; If ENDPOS is nil, it is safe not to scan before point
782 ;; since every line we indent is more deeply nested than point is. 790 ;; since every line we indent is more deeply nested than point is.