X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Flisp-mode.el;h=ac05da6472e6bfa0015632cd99ccae7afc6b986e;hb=cf4cc0dd14696b858b35c0ad1ebbca16e8f86ecf;hp=2772387e88436fa277465916860deadb84e9ef4f;hpb=2fd9701a4f902054649dde9143a3f77809afee8f;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el index 2772387..ac05da6 100644 --- a/lisp/lisp-mode.el +++ b/lisp/lisp-mode.el @@ -43,58 +43,91 @@ (defvar emacs-lisp-mode-syntax-table nil) (defvar lisp-mode-abbrev-table nil) -;; XEmacs change -(defvar lisp-interaction-mode-popup-menu - (purecopy '("Lisp-Interaction" - ["Evaluate Last %_S-expression" eval-last-sexp] - ["Evaluate %_Whole Buffer" eval-current-buffer] - ["Evaluate Re%_gion" eval-region - :active (region-exists-p)] - "---" - ["%_Evaluate This Defun" eval-defun] - ["%_Instrument This Defun for Debugging" edebug-defun] - "---" - ["Find %_Function Source..." find-function +(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 Source..." find-variable + ["Find %_Variable..." find-variable :active (fboundp 'find-variable)] - ["%_Trace Function..." trace-function-background] - ["%_Untrace All Functions" untrace-all - :active (fboundp 'untrace-all)] - "---" - ["%_Comment Out Region" comment-region - :active (region-exists-p)] - "---" - ["Indent %_Line or Region" - (if (region-exists-p) - (call-interactively 'indent-region) - (call-interactively 'lisp-indent-line))] - ["Indent B%_alanced Expression" indent-sexp] - ["Indent %_Defun" - (progn - (beginning-of-defun) - (indent-sexp))] - "---" - "Look for debug-on-error under Options->General" - ))) + ["%_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 - (purecopy - (nconc - '("Emacs-Lisp" - ["%_Byte-Compile This File" emacs-lisp-byte-compile] - ["B%_yte-Compile/Load This File" emacs-lisp-byte-compile-and-load] - ["Byte-%_Recompile Directory..." byte-recompile-directory] - "---") - (cdr lisp-interaction-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 - (purecopy (cons "%_Lisp" (cdr emacs-lisp-mode-popup-menu)))) + (cons "%_Lisp" (construct-lisp-mode-menu nil t))) (if (not emacs-lisp-mode-syntax-table) (let ((i 0)) @@ -137,19 +170,11 @@ (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 ()) @@ -235,6 +260,16 @@ All commands in `shared-lisp-mode-map' are inherited by this map.") ;; 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) @@ -363,7 +398,13 @@ if that value is non-nil." (setq major-mode 'lisp-interaction-mode) (setq mode-name "Lisp Interaction") (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)) @@ -506,7 +547,7 @@ rigidly along with this one." (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) @@ -643,7 +684,7 @@ of the start of the containing expression." (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)) @@ -660,8 +701,16 @@ of the start of the containing expression." (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) @@ -742,6 +791,7 @@ of the start of the containing expression." (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) @@ -754,6 +804,8 @@ of the start of the containing expression." (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) @@ -763,12 +815,16 @@ of the start of the containing expression." (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.