;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
;; Copyright (C) 1985, 1996, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems
+;; Copyright (C) 1995 Tinker Systems.
;; Maintainer: FSF
;; Keywords: lisp, languages, dumped
;; The base major mode for editing Lisp code (used also for Emacs Lisp).
;; This mode is documented in the Emacs manual
-;; July/05/97 slb Converted to use easymenu.
-
;;; Code:
(defgroup lisp nil
(defvar emacs-lisp-mode-syntax-table nil)
(defvar lisp-mode-abbrev-table nil)
-;; XEmacs change
-(defvar lisp-interaction-mode-popup-menu nil)
-(defvar lisp-interaction-mode-popup-menu-1
- (purecopy '("Lisp-Interaction"
- ["Evaluate Last S-expression" eval-last-sexp]
- ["Evaluate Entire Buffer" eval-current-buffer]
- ["Evaluate Region" eval-region
- :active (region-exists-p)]
- "---"
- ["Evaluate This Defun" eval-defun]
- ;; FSF says "Instrument Function for Debugging"
- ["Debug This Defun" edebug-defun]
- "---"
- ["Trace a Function" trace-function-background]
- ["Untrace All Functions" untrace-all
- :active (fboundp 'untrace-all)]
- "---"
- ["Comment Out Region" comment-region
- :active (region-exists-p)]
- ["Indent Region" indent-region
- :active (region-exists-p)]
- ["Indent Line" lisp-indent-line]
- "---"
- ["Debug On Error" (setq debug-on-error (not debug-on-error))
- :style toggle :selected debug-on-error]
- ["Debug On Quit" (setq debug-on-quit (not debug-on-quit))
- :style toggle :selected debug-on-quit]
- ["Debug on Signal" (setq debug-on-signal (not debug-on-signal))
- :style toggle :selected debug-on-signal]
- )))
-
-(defvar emacs-lisp-mode-popup-menu nil)
-(defvar emacs-lisp-mode-popup-menu-1
- (purecopy
- (nconc
- '("Emacs-Lisp"
- ["Byte-compile This File" emacs-lisp-byte-compile]
- ["Byte-compile/load This" emacs-lisp-byte-compile-and-load]
- ["Byte-recompile Directory..." byte-recompile-directory]
- "---")
- (cdr lisp-interaction-mode-popup-menu-1))))
+(defun construct-lisp-mode-menu (popup-p emacs-lisp-p)
+ (flet ((popup-wrap (form)
+ (if popup-p `(menu-call-at-event ',form) form)))
+ `(,@(if emacs-lisp-p
+ `(["%_Byte-Compile This File" ,(popup-wrap
+ 'emacs-lisp-byte-compile)]
+ ["B%_yte-Compile/Load This File"
+ ,(popup-wrap 'emacs-lisp-byte-compile-and-load)]
+ ["Byte-%_Recompile Directory..."
+ ,(popup-wrap 'byte-recompile-directory)]
+ "---"))
+ ["%_Evaluate Region or Defun"
+ ,(popup-wrap '(if (region-exists-p)
+ (call-interactively 'eval-region)
+ (call-interactively 'eval-defun)))]
+ ["Evaluate %_Whole Buffer" ,(popup-wrap 'eval-current-buffer)]
+ ["Evaluate Last %_S-expression" ,(popup-wrap 'eval-last-sexp)]
+ "---"
+ ,@(if popup-p
+ '(["%_Find Function"
+ (find-function (menu-call-at-event '(function-at-point)))
+ :suffix (let ((fun (menu-call-at-event '(function-at-point))))
+ (if fun (symbol-name fun) ""))
+ :active (and (fboundp 'find-function)
+ (menu-call-at-event '(function-at-point)))]
+ ["%_Find Variable"
+ (find-variable (menu-call-at-event '(variable-at-point)))
+ :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
+ (if fun (symbol-name fun) ""))
+ :active (and (fboundp 'find-variable)
+ (menu-call-at-event '(variable-at-point)))]
+ ["%_Help on Function"
+ (describe-function (menu-call-at-event '(function-at-point)))
+ :suffix (let ((fun (menu-call-at-event '(function-at-point))))
+ (if fun (symbol-name fun) ""))
+ :active (and (fboundp 'describe-function)
+ (menu-call-at-event '(function-at-point)))]
+ ["%_Help on Variable"
+ (describe-variable (menu-call-at-event '(variable-at-point)))
+ :suffix (let ((fun (menu-call-at-event '(variable-at-point))))
+ (if fun (symbol-name fun) ""))
+ :active (and (fboundp 'describe-variable)
+ (menu-call-at-event '(variable-at-point)))])
+ '(["Find %_Function..." find-function
+ :active (fboundp 'find-function)]
+ ["Find %_Variable..." find-variable
+ :active (fboundp 'find-variable)]
+ ["%_Help on Function..." describe-function
+ :active (fboundp 'describe-function)]
+ ["Hel%_p on Variable..." describe-variable
+ :active (fboundp 'describe-variable)]))
+ "---"
+ ["Instrument This Defun for %_Debugging" ,(popup-wrap 'edebug-defun)]
+ ["%_Trace Function..." trace-function-background]
+ ["%_Untrace All Functions" untrace-all
+ :active (fboundp 'untrace-all)]
+ "---"
+ ["%_Comment Out Region" comment-region :active (region-exists-p)]
+ "---"
+ ["%_Indent Region or Balanced Expression"
+ ,(popup-wrap '(if (region-exists-p)
+ (call-interactively 'indent-region)
+ (call-interactively 'indent-sexp)))]
+ ["I%_ndent Defun"
+ ,(popup-wrap '(progn
+ (beginning-of-defun)
+ (indent-sexp)))]
+ "---"
+ "Look for debug-on-error under Options->Troubleshooting"
+ )))
+
+(defvar lisp-interaction-mode-popup-menu
+ (cons "Lisp-Interaction" (construct-lisp-mode-menu t nil)))
+
+(defvar emacs-lisp-mode-popup-menu
+ (cons "Emacs-Lisp" (construct-lisp-mode-menu t t)))
;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the
;*scratch* buffer has a Lisp menubar item! Very confusing.
-;(defvar lisp-interaction-mode-menubar-menu
-; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu))))
+;Jan Vroonhof really wants this, so it's back. --ben
+(defvar lisp-interaction-mode-menubar-menu
+ (cons "%_Lisp" (construct-lisp-mode-menu nil nil)))
-(defvar emacs-lisp-mode-menubar-menu nil)
-(defvar emacs-lisp-mode-menubar-menu-1
- (purecopy (cons "Lisp" (cdr emacs-lisp-mode-popup-menu-1))))
+(defvar emacs-lisp-mode-menubar-menu
+ (cons "%_Lisp" (construct-lisp-mode-menu nil t)))
(if (not emacs-lisp-mode-syntax-table)
(let ((i 0))
(if (not lisp-mode-syntax-table)
(progn (setq lisp-mode-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table))
- (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table)
(modify-syntax-entry ?\[ "_ " lisp-mode-syntax-table)
;; XEmacs changes
(modify-syntax-entry ?\] "_ " lisp-mode-syntax-table)
- ;;
- ;; If emacs was compiled with NEW_SYNTAX, then do
- ;; CL's #| |# block comments.
- (if (= 8 (length (parse-partial-sexp (point) (point))))
- (progn
- (modify-syntax-entry ?# "' 58" lisp-mode-syntax-table)
- (modify-syntax-entry ?| ". 67" lisp-mode-syntax-table))
- ;; else, old style
- (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table))))
+ (modify-syntax-entry ?# "' 58" lisp-mode-syntax-table)
+ (modify-syntax-entry ?| "\" 67" lisp-mode-syntax-table)))
(define-abbrev-table 'lisp-mode-abbrev-table ())
;; doesn't need them.
)
+;; XEmacs: add docstrings to the hooks
+(defvar emacs-lisp-mode-hook nil
+ "Hook to run when entering emacs-lisp-mode.")
+
+(defvar lisp-mode-hook nil
+ "Hook to run when entering lisp-mode.")
+
+(defvar lisp-interaction-mode-hook nil
+ "Hook to run when entering lisp-interaction-mode.")
+
(defun emacs-lisp-byte-compile ()
"Byte compile the file containing the current buffer."
(interactive)
(set-syntax-table emacs-lisp-mode-syntax-table)
;; XEmacs changes
(setq major-mode 'emacs-lisp-mode
- ;; mode-popup-menu emacs-lisp-mode-popup-menu
+ mode-popup-menu emacs-lisp-mode-popup-menu
mode-name "Emacs-Lisp")
- ;; (if (and (featurep 'menubar)
- ;; current-menubar)
- ;; (progn
+ (if (and (featurep 'menubar)
+ current-menubar)
+ (progn
;; make a local copy of the menubar, so our modes don't
;; change the global menubar
- ;; (set-buffer-menubar current-menubar)
- ;; (add-submenu nil emacs-lisp-mode-menubar-menu)))
- (unless emacs-lisp-mode-popup-menu
- (easy-menu-define emacs-lisp-mode-popup-menu emacs-lisp-mode-map ""
- emacs-lisp-mode-popup-menu-1))
- (easy-menu-add emacs-lisp-mode-popup-menu)
+ (set-buffer-menubar current-menubar)
+ (add-submenu nil emacs-lisp-mode-menubar-menu)))
(lisp-mode-variables nil)
(run-hooks 'emacs-lisp-mode-hook))
+(put 'emacs-lisp-mode 'font-lock-lisp-like t)
+
(defvar lisp-mode-map ()
"Keymap for ordinary Lisp mode.
All commands in `shared-lisp-mode-map' are inherited by this map.")
(use-local-map lisp-interaction-mode-map)
(setq major-mode 'lisp-interaction-mode)
(setq mode-name "Lisp Interaction")
- ;; XEmacs change
- ;; (setq mode-popup-menu lisp-interaction-mode-popup-menu)
- (unless lisp-interaction-mode-popup-menu
- (easy-menu-define lisp-interaction-mode-popup-menu
- lisp-interaction-mode-map
- ""
- lisp-interaction-mode-popup-menu-1))
- (easy-menu-add lisp-interaction-mode-popup-menu)
-
+ (setq mode-popup-menu lisp-interaction-mode-popup-menu)
+ (if (and (featurep 'menubar)
+ current-menubar)
+ (progn
+ ;; make a local copy of the menubar, so our modes don't
+ ;; change the global menubar
+ (set-buffer-menubar current-menubar)
+ (add-submenu nil lisp-interaction-mode-menubar-menu)))
(set-syntax-table emacs-lisp-mode-syntax-table)
(lisp-mode-variables nil)
(run-hooks 'lisp-interaction-mode-hook))
(if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
;; Single-semicolon comment lines should be indented
;; as comment lines, not as code.
- (progn (indent-for-comment) (forward-char -1))
+ (progn (indent-for-comment) (backward-char 1))
(if (listp indent) (setq indent (car indent)))
(setq shift-amt (- indent (current-column)))
(if (zerop shift-amt)
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(if (and (elt state 2)
(not (looking-at "\\sw\\|\\s_")))
- ;; car of form doesn't seem to be a a symbol
+ ;; car of form doesn't seem to be a symbol
(progn
(if (not (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp))
(let ((function (buffer-substring (point)
(progn (forward-sexp 1) (point))))
method)
- (setq method (or (get (intern-soft function) 'lisp-indent-function)
- (get (intern-soft function) 'lisp-indent-hook)))
+ (if (condition-case nil
+ (save-excursion
+ (backward-up-list 1)
+ (backward-up-list 1)
+ (backward-up-list 1)
+ (looking-at "(flet\\s-"))
+ (error nil))
+ (setq method 'defun)
+ (setq method (or (get (intern-soft function) 'lisp-indent-function)
+ (get (intern-soft function) 'lisp-indent-hook))))
(cond ((or (eq method 'defun)
(and (null method)
(> (length function) 3)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-window-excursion 'lisp-indent-function 0)
(put 'save-selected-window 'lisp-indent-function 0)
+(put 'with-selected-window 'lisp-indent-function 1)
(put 'save-selected-frame 'lisp-indent-function 0)
(put 'with-selected-frame 'lisp-indent-function 1)
(put 'save-restriction 'lisp-indent-function 0)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)
(put 'let-specifier 'lisp-indent-function 1)
+(put 'flet 'lisp-indent-function 1)
(put 'while 'lisp-indent-function 1)
(put 'if 'lisp-indent-function 2)
(put 'catch 'lisp-indent-function 1)
(put 'condition-case 'lisp-indent-function 2)
+(put 'handler-case 'lisp-indent-function 1)
+(put 'handler-bind 'lisp-indent-function 1)
(put 'call-with-condition-handler 'lisp-indent-function 2)
(put 'unwind-protect 'lisp-indent-function 1)
(put 'save-current-buffer 'lisp-indent-function 0)
(put 'with-temp-buffer 'lisp-indent-function 0)
(put 'with-output-to-string 'lisp-indent-function 0)
(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
+(put 'with-slots 'lisp-indent-function 2)
+(put 'with-open-file 'lisp-indent-function 1)
+(put 'with-open-stream 'lisp-indent-function 1)
(put 'eval-after-load 'lisp-indent-function 1)
(put 'display-message 'lisp-indent-function 1)
(put 'display-warning 'lisp-indent-function 1)
(put 'lmessage 'lisp-indent-function 2)
(put 'lwarn 'lisp-indent-function 2)
(put 'global-set-key 'lisp-indent-function 1)
+(put 'print-unreadable-object 'lisp-indent-function 1)
(defun indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
projects / chise / xemacs-chise.git.1 / blobdiff