X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Flisp-mode.el;h=ac05da6472e6bfa0015632cd99ccae7afc6b986e;hb=a91886336030ac6177807a6d0f024a400cc610fb;hp=fee10bd95ea152618c4e835afa9aa14c58aaed19;hpb=b73e352f264e9da0a00159dc29f318305cbe8636;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el
index fee10bd..ac05da6 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))
@@ -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)
@@ -274,19 +309,15 @@ 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))
 
@@ -366,15 +397,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))
@@ -517,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)
@@ -654,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))
@@ -671,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)
@@ -753,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)
@@ -760,10 +799,13 @@ 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)
 (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)
@@ -773,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.