diff lisp/electric/ehelp.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents b82b59fe008d
children b9518feda344
line wrap: on
line diff
--- a/lisp/electric/ehelp.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/electric/ehelp.el	Mon Aug 13 09:02:59 2007 +0200
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
 
 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
+
 ;; Maintainer: FSF
 ;; Keywords: help, extensions
 
@@ -20,10 +21,9 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 19.30.
 
 ;;; Commentary:
 
@@ -42,15 +42,15 @@
 ;;; Code:
 
 (require 'electric)
-(defvar electric-help-map ()
+
+(defvar electric-help-map nil
   "Keymap defining commands available in `electric-help-mode'.")
 
-(defvar electric-help-form-to-execute nil)
-
 (put 'electric-help-undefined 'suppress-keymap t)
 (if electric-help-map
     ()
   (let ((map (make-keymap)))
+    (set-keymap-name map 'electric-help-map)
     ;; allow all non-self-inserting keys - search, scroll, etc, but
     ;; let M-x and C-x exit ehelp mode and retain buffer:
     (suppress-keymap map)
@@ -67,7 +67,6 @@
     (define-key map [(control ?9)] 'electric-help-undefined)
     (define-key map (char-to-string help-char) 'electric-help-help)
     (define-key map "?" 'electric-help-help)
-    ;; XEmacs addition
     (define-key map 'help 'electric-help-help)
     (define-key map " " 'scroll-up)
     (define-key map "\^?" 'scroll-down)
@@ -87,14 +86,13 @@
 
 (defun electric-help-mode ()
   "`with-electric-help' temporarily places its buffer in this mode.
-\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
+\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.\)"
   (setq buffer-read-only t)
   (setq mode-name "Help")
   (setq major-mode 'help)
   (setq modeline-buffer-identification '(" Help:  %b"))
   (use-local-map electric-help-map)
-  (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-  (view-mode -1)
+  (setq mouse-leave-buffer-hook '(electric-help-retain))
   ;; this is done below in with-electric-help
   ;(run-hooks 'electric-help-mode-hook)
   )
@@ -128,7 +126,7 @@
   (let ((one (one-window-p t))
 	(config (current-window-configuration))
         (bury nil)
-        (electric-help-form-to-execute nil))
+        (to-be-executed nil))
     (unwind-protect
 	(save-excursion
 	  (if one (goto-char (window-start (selected-window))))
@@ -140,8 +138,7 @@
 		(enlarge-window (- minheight (window-height))))
 	    (electric-help-mode)
 	    (setq buffer-read-only nil)
-	    (or noerase
-		(erase-buffer)))
+	    (or noerase (erase-buffer)))
 	  (let ((standard-output buffer))
 	    (if (not (funcall thunk))
 		(progn
@@ -151,15 +148,14 @@
 		  (if one (shrink-window-if-larger-than-buffer (selected-window))))))
 	  (set-buffer buffer)
 	  (run-hooks 'electric-help-mode-hook)
-	  (setq buffer-read-only t)
 	  (if (eq (car-safe
-		   ;; XEmacs: Don't be screwed by minor-modes (view-minor-mode)
+		   ;; Don't be screwed by minor-modes (view-minor-mode)
 		   (let ((overriding-local-map electric-help-map))
 		     (electric-help-command-loop)))
 		  'retain)
 	      (setq config (current-window-configuration))
 	    (setq bury t)))
-      (message "")
+      (message nil)
       (set-buffer buffer)
       (setq buffer-read-only nil)
       (condition-case ()
@@ -173,13 +169,12 @@
             (replace-buffer-in-windows buffer)
             ;; must do this outside of save-window-excursion
             (bury-buffer buffer)))
-      (eval electric-help-form-to-execute))))
+      (eval to-be-executed))))
 
 (defun electric-help-command-loop ()
   (catch 'exit
     (if (pos-visible-in-window-p (point-max))
-	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
-	       ;; XEmacs change
+	(progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
 	       (if (equal (setq unread-command-events
 				(list (next-command-event)))
 			  '(?\ ))
@@ -224,14 +219,14 @@
 
 
 ;(defun electric-help-scroll-up (arg)
-;  ">>>Doc"
+;  "####Doc"
 ;  (interactive "P")
 ;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
 ;      (electric-help-exit)
 ;    (scroll-up arg)))
 
 (defun electric-help-exit ()
-  ">>>Doc"
+  "####Doc"
   (interactive)
   (throw 'exit t))
 
@@ -242,11 +237,27 @@
   (interactive)
   ;; Make sure that we don't throw twice, even if two events cause
   ;; calling this function:
-  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
-      (progn
-	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-	(throw 'exit '(retain)))))
+  (if mouse-leave-buffer-hook
+    (progn
+      (setq mouse-leave-buffer-hook nil)
+      (throw 'exit '(retain)))))
+
 
+;(defun electric-help-undefined ()
+;  (interactive)
+;  (let* ((keys (this-command-keys))
+;	 (n (length keys)))
+;    (if (or (= n 1)
+;	    (and (= n 2)
+;		 meta-flag
+;		 (eq (aref keys 0) meta-prefix-char)))
+;	(setq unread-command-char last-input-char
+;	      current-prefix-arg prefix-arg)
+;      ;;#### I don't care.
+;      ;;#### The emacs command-loop is too much pure pain to
+;      ;;#### duplicate
+;      ))
+;  (throw 'exit t))
 
 (defun electric-help-undefined ()
   (interactive)
@@ -257,7 +268,7 @@
 	   (substitute-command-keys "\\[electric-help-exit]"))))
 
 
-;>>> this needs to be hairified (recursive help, anybody?)
+;#### this needs to be hairified (recursive help, anybody?)
 (defun electric-help-help ()
   (interactive)
   (if (and (eq (key-binding "q") 'electric-help-exit)
@@ -270,56 +281,35 @@
 
 
 ;;;###autoload
-(defun electric-helpify (fun &optional name)
-  (let ((name (or name "*Help*")))
-    (if (save-window-excursion
-	  ;; kludge-o-rama
-	  (let* ((p (symbol-function 'print-help-return-message))
-		 (b (get-buffer name))
-		 (m (buffer-modified-p b)))
-	    (and b (not (get-buffer-window b))
-		 (setq b nil))
-	    (unwind-protect
-		(progn
-		  (message "%s..." (capitalize (symbol-name fun)))
-		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
-		  ;; kludging excessively and relying on that as some sort
-		  ;;  of indication leads to the following abomination...
-		  ;;>> This would be doable without such icky kludges if either
-		  ;;>> (a) there were a function to read the interactive
-		  ;;>>     args for a command and return a list of those args.
-		  ;;>>     (To which one would then just apply the command)
-		  ;;>>     (The only problem with this is that interactive-p
-		  ;;>>      would break, but that is such a misfeature in
-		  ;;>>      any case that I don't care)
-		  ;;>>     It is easy to do this for emacs-lisp functions;
-		  ;;>>     the only problem is getting the interactive spec
-		  ;;>>     for subrs
-		  ;;>> (b) there were a function which returned a
-		  ;;>>     modification-tick for a buffer.  One could tell
-		  ;;>>     whether a buffer had changed by whether the
-		  ;;>>     modification-tick were different.
-		  ;;>>     (Presumably there would have to be a way to either
-		  ;;>>      restore the tick to some previous value, or to
-		  ;;>>      suspend updating of the tick in order to allow
-		  ;;>>      things like momentary-string-display)
-		  (and b
-		       (save-excursion
-			 (set-buffer b)
-			 (set-buffer-modified-p t)))
-		  (fset 'print-help-return-message 'ignore)
-		  (call-interactively fun)
-		  (and (get-buffer name)
-		       (get-buffer-window (get-buffer name))
-		       (or (not b)
-			   (not (eq b (get-buffer name)))
-			   (not (buffer-modified-p b)))))
-	      (fset 'print-help-return-message p)
-	      (and b (buffer-name b)
-		   (save-excursion
-		     (set-buffer b)
-		     (set-buffer-modified-p m))))))
-	(with-electric-help 'ignore name t))))
+(defun electric-helpify (fun &optional buffer-name)
+  (or buffer-name (setq buffer-name "*Help*"))
+  (let* ((p (symbol-function 'print-help-return-message))
+         (b (get-buffer buffer-name))
+         (tick (and b (buffer-modified-tick b))))
+    (and b (not (get-buffer-window b))
+         (setq b nil))
+    (if (unwind-protect
+             (save-window-excursion
+               (message "%s..." (capitalize (symbol-name fun)))
+               ;; kludge-o-rama
+               (fset 'print-help-return-message 'ignore)
+               (let ((a (call-interactively fun 'lambda)))
+                 (let ((temp-buffer-show-function 'ignore))
+                   (apply fun a)))
+               (message nil)
+               ;; Was a non-empty help buffer created/modified?
+               (let ((r (get-buffer buffer-name)))
+                 (and r
+                      ;(get-buffer-window r)
+                      (or (not b)
+                          (not (eq b r))
+                          (not (eql tick (buffer-modified-tick b))))
+                      (save-excursion
+                        (set-buffer r)
+                        (> (buffer-size) 0)))))
+	  (fset 'print-help-return-message p)
+	  )
+        (with-electric-help 'ignore buffer-name t))))
 
 
 
@@ -327,14 +317,14 @@
 ;; continues with execute-extended-command.
 (defun electric-help-execute-extended (prefixarg)
   (interactive "p")
-  (setq electric-help-form-to-execute '(execute-extended-command nil))
+  (setq to-be-executed '(execute-extended-command nil))
   (electric-help-retain))
 
 ;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
 ;; continues with ctrl-x prefix.
 (defun electric-help-ctrl-x-prefix (prefixarg)
   (interactive "p")
-  (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
+  (setq to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x)))
   (electric-help-retain))
 
 
@@ -373,7 +363,7 @@
 
 (defun electric-command-apropos ()
   (interactive)
-  (electric-helpify 'command-apropos "*Apropos*"))
+  (electric-helpify 'command-apropos))
 
 ;(define-key help-map "a" 'electric-command-apropos)
 
@@ -381,10 +371,11 @@
   (interactive)
   (electric-helpify 'apropos))
 
+
 
 ;;;; ehelp-map
 
-(defvar ehelp-map ())
+(defvar ehelp-map nil)
 (if ehelp-map
     nil
   ;; #### WTF?  Why don't we just use substitute-key-definition