diff lisp/electric/ehelp.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents 376386a54a3c
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/electric/ehelp.el	Mon Aug 13 08:46:35 2007 +0200
+++ b/lisp/electric/ehelp.el	Mon Aug 13 08:46:56 2007 +0200
@@ -3,7 +3,6 @@
 ;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
 
 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
-
 ;; Maintainer: FSF
 ;; Keywords: help, extensions
 
@@ -21,9 +20,10 @@
 
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
 
 ;;; Commentary:
 
@@ -42,15 +42,15 @@
 ;;; Code:
 
 (require 'electric)
+(defvar electric-help-map ()
+  "Keymap defining commands available in `electric-help-mode'.")
 
-(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,6 +67,7 @@
     (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)
@@ -86,13 +87,14 @@
 
 (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)
-  (setq mouse-leave-buffer-hook '(electric-help-retain))
+  (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+  (view-mode -1)
   ;; this is done below in with-electric-help
   ;(run-hooks 'electric-help-mode-hook)
   )
@@ -126,7 +128,7 @@
   (let ((one (one-window-p t))
 	(config (current-window-configuration))
         (bury nil)
-        (to-be-executed nil))
+        (electric-help-form-to-execute nil))
     (unwind-protect
 	(save-excursion
 	  (if one (goto-char (window-start (selected-window))))
@@ -138,7 +140,8 @@
 		(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
@@ -148,14 +151,15 @@
 		  (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
-		   ;; Don't be screwed by minor-modes (view-minor-mode)
+		   ;; XEmacs: 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 nil)
+      (message "")
       (set-buffer buffer)
       (setq buffer-read-only nil)
       (condition-case ()
@@ -169,12 +173,13 @@
             (replace-buffer-in-windows buffer)
             ;; must do this outside of save-window-excursion
             (bury-buffer buffer)))
-      (eval to-be-executed))))
+      (eval electric-help-form-to-execute))))
 
 (defun electric-help-command-loop ()
   (catch 'exit
     (if (pos-visible-in-window-p (point-max))
-	(progn (message (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
+	       ;; XEmacs change
 	       (if (equal (setq unread-command-events
 				(list (next-command-event)))
 			  '(?\ ))
@@ -219,14 +224,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))
 
@@ -237,27 +242,11 @@
   (interactive)
   ;; Make sure that we don't throw twice, even if two events cause
   ;; calling this function:
-  (if mouse-leave-buffer-hook
-    (progn
-      (setq mouse-leave-buffer-hook nil)
-      (throw 'exit '(retain)))))
-
+  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
+      (progn
+	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
+	(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)
@@ -268,7 +257,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)
@@ -281,35 +270,56 @@
 
 
 ;;;###autoload
-(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))))
+(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))))
 
 
 
@@ -317,14 +327,14 @@
 ;; continues with execute-extended-command.
 (defun electric-help-execute-extended (prefixarg)
   (interactive "p")
-  (setq to-be-executed '(execute-extended-command nil))
+  (setq electric-help-form-to-execute '(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 to-be-executed '(progn (message nil) (setq unread-command-char ?\C-x)))
+  (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
   (electric-help-retain))
 
 
@@ -363,7 +373,7 @@
 
 (defun electric-command-apropos ()
   (interactive)
-  (electric-helpify 'command-apropos))
+  (electric-helpify 'command-apropos "*Apropos*"))
 
 ;(define-key help-map "a" 'electric-command-apropos)
 
@@ -371,11 +381,10 @@
   (interactive)
   (electric-helpify 'apropos))
 
-
 
 ;;;; ehelp-map
 
-(defvar ehelp-map nil)
+(defvar ehelp-map ())
 (if ehelp-map
     nil
   ;; #### WTF?  Why don't we just use substitute-key-definition