comparison lisp/lisp-mode.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents a5df635868b2
children 1ccc32a20af4
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands. 1 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
2 2
3 ;; Copyright (C) 1985, 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1996, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems 4 ;; Copyright (C) 1995 Tinker Systems.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 ;; Keywords: lisp, languages, dumped 7 ;; Keywords: lisp, languages, dumped
8 8
9 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
30 ;; This file is dumped with XEmacs. 30 ;; This file is dumped with XEmacs.
31 31
32 ;; The base major mode for editing Lisp code (used also for Emacs Lisp). 32 ;; The base major mode for editing Lisp code (used also for Emacs Lisp).
33 ;; This mode is documented in the Emacs manual 33 ;; This mode is documented in the Emacs manual
34 34
35 ;; July/05/97 slb Converted to use easymenu.
36
37 ;;; Code: 35 ;;; Code:
38 36
39 (defgroup lisp nil 37 (defgroup lisp nil
40 "Lisp support, including Emacs Lisp." 38 "Lisp support, including Emacs Lisp."
41 :group 'languages 39 :group 'languages
43 41
44 (defvar lisp-mode-syntax-table nil) 42 (defvar lisp-mode-syntax-table nil)
45 (defvar emacs-lisp-mode-syntax-table nil) 43 (defvar emacs-lisp-mode-syntax-table nil)
46 (defvar lisp-mode-abbrev-table nil) 44 (defvar lisp-mode-abbrev-table nil)
47 45
48 ;; XEmacs change 46 (defun construct-lisp-mode-menu (popup-p emacs-lisp-p)
49 (defvar lisp-interaction-mode-popup-menu nil) 47 (flet ((popup-wrap (form)
50 (defvar lisp-interaction-mode-popup-menu-1 48 (if popup-p `(menu-call-at-event ',form) form)))
51 (purecopy '("Lisp-Interaction" 49 `(,@(if emacs-lisp-p
52 ["Evaluate Last S-expression" eval-last-sexp] 50 `(["%_Byte-Compile This File" ,(popup-wrap
53 ["Evaluate Entire Buffer" eval-current-buffer] 51 'emacs-lisp-byte-compile)]
54 ["Evaluate Region" eval-region 52 ["B%_yte-Compile/Load This File"
55 :active (region-exists-p)] 53 ,(popup-wrap 'emacs-lisp-byte-compile-and-load)]
56 "---" 54 ["Byte-%_Recompile Directory..."
57 ["Evaluate This Defun" eval-defun] 55 ,(popup-wrap 'byte-recompile-directory)]
58 ;; FSF says "Instrument Function for Debugging" 56 "---"))
59 ["Debug This Defun" edebug-defun] 57 ["%_Evaluate Region or Defun"
60 "---" 58 ,(popup-wrap '(if (region-exists-p)
61 ["Trace a Function" trace-function-background] 59 (call-interactively 'eval-region)
62 ["Untrace All Functions" untrace-all 60 (call-interactively 'eval-defun)))]
63 :active (fboundp 'untrace-all)] 61 ["Evaluate %_Whole Buffer" ,(popup-wrap 'eval-current-buffer)]
64 "---" 62 ["Evaluate Last %_S-expression" ,(popup-wrap 'eval-last-sexp)]
65 ["Comment Out Region" comment-region 63 "---"
66 :active (region-exists-p)] 64 ,@(if popup-p
67 ["Indent Region" indent-region 65 '(["%_Find Function"
68 :active (region-exists-p)] 66 (find-function (menu-call-at-event '(function-at-point)))
69 ["Indent Line" lisp-indent-line] 67 :suffix (let ((fun (menu-call-at-event '(function-at-point))))
70 "---" 68 (if fun (symbol-name fun) ""))
71 ["Debug On Error" (setq debug-on-error (not debug-on-error)) 69 :active (and (fboundp 'find-function)
72 :style toggle :selected debug-on-error] 70 (menu-call-at-event '(function-at-point)))]
73 ["Debug On Quit" (setq debug-on-quit (not debug-on-quit)) 71 ["%_Find Variable"
74 :style toggle :selected debug-on-quit] 72 (find-variable (menu-call-at-event '(variable-at-point)))
75 ["Debug on Signal" (setq debug-on-signal (not debug-on-signal)) 73 :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
76 :style toggle :selected debug-on-signal] 74 (if fun (symbol-name fun) ""))
77 ))) 75 :active (and (fboundp 'find-variable)
78 76 (menu-call-at-event '(variable-at-point)))]
79 (defvar emacs-lisp-mode-popup-menu nil) 77 ["%_Help on Function"
80 (defvar emacs-lisp-mode-popup-menu-1 78 (describe-function (menu-call-at-event '(function-at-point)))
81 (purecopy 79 :suffix (let ((fun (menu-call-at-event '(function-at-point))))
82 (nconc 80 (if fun (symbol-name fun) ""))
83 '("Emacs-Lisp" 81 :active (and (fboundp 'describe-function)
84 ["Byte-compile This File" emacs-lisp-byte-compile] 82 (menu-call-at-event '(function-at-point)))]
85 ["Byte-compile/load This" emacs-lisp-byte-compile-and-load] 83 ["%_Help on Variable"
86 ["Byte-recompile Directory..." byte-recompile-directory] 84 (describe-variable (menu-call-at-event '(variable-at-point)))
87 "---") 85 :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
88 (cdr lisp-interaction-mode-popup-menu-1)))) 86 (if fun (symbol-name fun) ""))
87 :active (and (fboundp 'describe-variable)
88 (menu-call-at-event '(variable-at-point)))])
89 '(["Find %_Function..." find-function
90 :active (fboundp 'find-function)]
91 ["Find %_Variable..." find-variable
92 :active (fboundp 'find-variable)]
93 ["%_Help on Function..." describe-function
94 :active (fboundp 'describe-function)]
95 ["Hel%_p on Variable..." describe-variable
96 :active (fboundp 'describe-variable)]))
97 "---"
98 ["Instrument This Defun for %_Debugging" ,(popup-wrap 'edebug-defun)]
99 ["%_Trace Function..." trace-function-background]
100 ["%_Untrace All Functions" untrace-all
101 :active (fboundp 'untrace-all)]
102 "---"
103 ["%_Comment Out Region" comment-region :active (region-exists-p)]
104 "---"
105 ["%_Indent Region or Balanced Expression"
106 ,(popup-wrap '(if (region-exists-p)
107 (call-interactively 'indent-region)
108 (call-interactively 'indent-sexp)))]
109 ["I%_ndent Defun"
110 ,(popup-wrap '(progn
111 (beginning-of-defun)
112 (indent-sexp)))]
113 "---"
114 "Look for debug-on-error under Options->Troubleshooting"
115 )))
116
117 (defvar lisp-interaction-mode-popup-menu
118 (cons "Lisp-Interaction" (construct-lisp-mode-menu t nil)))
119
120 (defvar emacs-lisp-mode-popup-menu
121 (cons "Emacs-Lisp" (construct-lisp-mode-menu t t)))
89 122
90 ;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the 123 ;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the
91 ;*scratch* buffer has a Lisp menubar item! Very confusing. 124 ;*scratch* buffer has a Lisp menubar item! Very confusing.
92 ;(defvar lisp-interaction-mode-menubar-menu 125 ;Jan Vroonhof really wants this, so it's back. --ben
93 ; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu)))) 126 (defvar lisp-interaction-mode-menubar-menu
94 127 (cons "%_Lisp" (construct-lisp-mode-menu nil nil)))
95 (defvar emacs-lisp-mode-menubar-menu nil) 128
96 (defvar emacs-lisp-mode-menubar-menu-1 129 (defvar emacs-lisp-mode-menubar-menu
97 (purecopy (cons "Lisp" (cdr emacs-lisp-mode-popup-menu-1)))) 130 (cons "%_Lisp" (construct-lisp-mode-menu nil t)))
98 131
99 (if (not emacs-lisp-mode-syntax-table) 132 (if (not emacs-lisp-mode-syntax-table)
100 (let ((i 0)) 133 (let ((i 0))
101 (setq emacs-lisp-mode-syntax-table (make-syntax-table)) 134 (setq emacs-lisp-mode-syntax-table (make-syntax-table))
102 (while (< i ?0) 135 (while (< i ?0)
272 (kill-all-local-variables) 305 (kill-all-local-variables)
273 (use-local-map emacs-lisp-mode-map) 306 (use-local-map emacs-lisp-mode-map)
274 (set-syntax-table emacs-lisp-mode-syntax-table) 307 (set-syntax-table emacs-lisp-mode-syntax-table)
275 ;; XEmacs changes 308 ;; XEmacs changes
276 (setq major-mode 'emacs-lisp-mode 309 (setq major-mode 'emacs-lisp-mode
277 ;; mode-popup-menu emacs-lisp-mode-popup-menu 310 mode-popup-menu emacs-lisp-mode-popup-menu
278 mode-name "Emacs-Lisp") 311 mode-name "Emacs-Lisp")
279 ;; (if (and (featurep 'menubar) 312 (if (and (featurep 'menubar)
280 ;; current-menubar) 313 current-menubar)
281 ;; (progn 314 (progn
282 ;; make a local copy of the menubar, so our modes don't 315 ;; make a local copy of the menubar, so our modes don't
283 ;; change the global menubar 316 ;; change the global menubar
284 ;; (set-buffer-menubar current-menubar) 317 (set-buffer-menubar current-menubar)
285 ;; (add-submenu nil emacs-lisp-mode-menubar-menu))) 318 (add-submenu nil emacs-lisp-mode-menubar-menu)))
286 (unless emacs-lisp-mode-popup-menu
287 (easy-menu-define emacs-lisp-mode-popup-menu emacs-lisp-mode-map ""
288 emacs-lisp-mode-popup-menu-1))
289 (easy-menu-add emacs-lisp-mode-popup-menu)
290 (lisp-mode-variables nil) 319 (lisp-mode-variables nil)
291 (run-hooks 'emacs-lisp-mode-hook)) 320 (run-hooks 'emacs-lisp-mode-hook))
292 321
293 (put 'emacs-lisp-mode 'font-lock-lisp-like t) 322 (put 'emacs-lisp-mode 'font-lock-lisp-like t)
294 323
364 (interactive) 393 (interactive)
365 (kill-all-local-variables) 394 (kill-all-local-variables)
366 (use-local-map lisp-interaction-mode-map) 395 (use-local-map lisp-interaction-mode-map)
367 (setq major-mode 'lisp-interaction-mode) 396 (setq major-mode 'lisp-interaction-mode)
368 (setq mode-name "Lisp Interaction") 397 (setq mode-name "Lisp Interaction")
369 ;; XEmacs change 398 (setq mode-popup-menu lisp-interaction-mode-popup-menu)
370 ;; (setq mode-popup-menu lisp-interaction-mode-popup-menu) 399 (if (and (featurep 'menubar)
371 (unless lisp-interaction-mode-popup-menu 400 current-menubar)
372 (easy-menu-define lisp-interaction-mode-popup-menu 401 (progn
373 lisp-interaction-mode-map 402 ;; make a local copy of the menubar, so our modes don't
374 "" 403 ;; change the global menubar
375 lisp-interaction-mode-popup-menu-1)) 404 (set-buffer-menubar current-menubar)
376 (easy-menu-add lisp-interaction-mode-popup-menu) 405 (add-submenu nil lisp-interaction-mode-menubar-menu)))
377
378 (set-syntax-table emacs-lisp-mode-syntax-table) 406 (set-syntax-table emacs-lisp-mode-syntax-table)
379 (lisp-mode-variables nil) 407 (lisp-mode-variables nil)
380 (run-hooks 'lisp-interaction-mode-hook)) 408 (run-hooks 'lisp-interaction-mode-hook))
381 409
382 (defun eval-print-last-sexp () 410 (defun eval-print-last-sexp ()
669 (backward-prefix-chars) 697 (backward-prefix-chars)
670 (current-column)) 698 (current-column))
671 (let ((function (buffer-substring (point) 699 (let ((function (buffer-substring (point)
672 (progn (forward-sexp 1) (point)))) 700 (progn (forward-sexp 1) (point))))
673 method) 701 method)
674 (setq method (or (get (intern-soft function) 'lisp-indent-function) 702 (if (condition-case nil
675 (get (intern-soft function) 'lisp-indent-hook))) 703 (save-excursion
704 (backward-up-list 1)
705 (backward-up-list 1)
706 (backward-up-list 1)
707 (looking-at "(flet\\s-"))
708 (error nil))
709 (setq method 'defun)
710 (setq method (or (get (intern-soft function) 'lisp-indent-function)
711 (get (intern-soft function) 'lisp-indent-hook))))
676 (cond ((or (eq method 'defun) 712 (cond ((or (eq method 'defun)
677 (and (null method) 713 (and (null method)
678 (> (length function) 3) 714 (> (length function) 3)
679 (string-match "\\`def" function))) 715 (string-match "\\`def" function)))
680 (lisp-indent-defform state indent-point)) 716 (lisp-indent-defform state indent-point))
751 (put 'prog1 'lisp-indent-function 1) 787 (put 'prog1 'lisp-indent-function 1)
752 (put 'prog2 'lisp-indent-function 2) 788 (put 'prog2 'lisp-indent-function 2)
753 (put 'save-excursion 'lisp-indent-function 0) 789 (put 'save-excursion 'lisp-indent-function 0)
754 (put 'save-window-excursion 'lisp-indent-function 0) 790 (put 'save-window-excursion 'lisp-indent-function 0)
755 (put 'save-selected-window 'lisp-indent-function 0) 791 (put 'save-selected-window 'lisp-indent-function 0)
792 (put 'with-selected-window 'lisp-indent-function 1)
756 (put 'save-selected-frame 'lisp-indent-function 0) 793 (put 'save-selected-frame 'lisp-indent-function 0)
757 (put 'with-selected-frame 'lisp-indent-function 1) 794 (put 'with-selected-frame 'lisp-indent-function 1)
758 (put 'save-restriction 'lisp-indent-function 0) 795 (put 'save-restriction 'lisp-indent-function 0)
759 (put 'save-match-data 'lisp-indent-function 0) 796 (put 'save-match-data 'lisp-indent-function 0)
760 (put 'let 'lisp-indent-function 1) 797 (put 'let 'lisp-indent-function 1)
761 (put 'let* 'lisp-indent-function 1) 798 (put 'let* 'lisp-indent-function 1)
762 (put 'let-specifier 'lisp-indent-function 1) 799 (put 'let-specifier 'lisp-indent-function 1)
800 (put 'flet 'lisp-indent-function 1)
763 (put 'while 'lisp-indent-function 1) 801 (put 'while 'lisp-indent-function 1)
764 (put 'if 'lisp-indent-function 2) 802 (put 'if 'lisp-indent-function 2)
765 (put 'catch 'lisp-indent-function 1) 803 (put 'catch 'lisp-indent-function 1)
766 (put 'condition-case 'lisp-indent-function 2) 804 (put 'condition-case 'lisp-indent-function 2)
767 (put 'call-with-condition-handler 'lisp-indent-function 2) 805 (put 'call-with-condition-handler 'lisp-indent-function 2)