X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Flisp-mode.el;h=8fcec4565a466cb0bc75ce7a16120f1c733758c1;hp=d1932889d6db9c508353790b7e76c6fb3f116e31;hb=82f6d62ee211b1d36e8f45fed3ee3edde82b6916;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el index d193288..8fcec45 100644 --- a/lisp/lisp-mode.el +++ b/lisp/lisp-mode.el @@ -1,7 +1,7 @@ ;;; 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 @@ -32,8 +32,6 @@ ;; 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 @@ -45,56 +43,91 @@ (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)) @@ -274,22 +307,20 @@ if that value is non-nil." (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.") @@ -364,15 +395,14 @@ if that value is non-nil." (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)) @@ -515,7 +545,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) @@ -669,8 +699,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) @@ -751,6 +789,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) @@ -758,6 +797,7 @@ of the start of the containing expression." (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) @@ -766,6 +806,7 @@ of the start of the containing expression." (put 'unwind-protect 'lisp-indent-function 1) (put 'save-current-buffer 'lisp-indent-function 0) (put 'with-current-buffer 'lisp-indent-function 1) +(put 'with-string-as-buffer-contents 'lisp-indent-function 1) (put 'with-temp-file 'lisp-indent-function 1) (put 'with-temp-buffer 'lisp-indent-function 0) (put 'with-output-to-string 'lisp-indent-function 0)