XEmacs 21.2.24 "Hecate".
[chise/xemacs-chise.git.1] / lisp / help.el
index 5f43c0c..8651aab 100644 (file)
@@ -305,8 +305,8 @@ otherwise it is killed."
   "Return the command invoked by KEY.
 Like `key-binding', but handles menu events and toolbar presses correctly.
 KEY is any value returned by `next-command-event'.
-MENU-FLAG is a symbol that should be set to T if KEY is a menu event,
- or NIL otherwise"
+MENU-FLAG is a symbol that should be set to t if KEY is a menu event,
+ or nil otherwise"
   (let (defn)
     (and menu-flag (set menu-flag nil))
     ;; If the key typed was really a menu selection, grab the form out
@@ -461,7 +461,9 @@ You should never set this directory, only let-bind it.")
   (if (and (integerp help-max-help-buffers)
            (> help-max-help-buffers 0)
            (stringp name))
-      (format "*%s: %s*" help-buffer-prefix-string name)
+      (if help-buffer-prefix-string
+         (format "*%s: %s*" help-buffer-prefix-string name)
+       (format "*%s*" name))
     (format "*%s*" help-buffer-prefix-string)))
 
 ;; Use this function for displaying help when C-h something is pressed
@@ -655,9 +657,20 @@ then only the mouse bindings are displayed."
             (gettext "key             binding\n---             -------\n")))
         (buffer (current-buffer))
         (minor minor-mode-map-alist)
+       (extent-maps (mapcar-extents
+                     'extent-keymap
+                     nil (current-buffer) (point) (point) nil 'keymap))
         (local (current-local-map))
         (shadow '()))
     (set-buffer standard-output)
+    (while extent-maps
+      (insert "Bindings for Text Region:\n"
+             heading)
+      (describe-bindings-internal
+       (car extent-maps) nil shadow prefix mouse-only-p)
+       (insert "\n")
+       (setq shadow (cons (car extent-maps) shadow)
+            extent-maps (cdr extent-maps)))
     (while minor
       (let ((sym (car (car minor)))
             (map (cdr (car minor))))
@@ -914,15 +927,11 @@ unless the function is autoloaded."
   :type 'boolean
   :group 'help-appearance)
 
-(defun describe-symbol-find-file (function)
-  (let ((files load-history)
-       file)
-    (while files
-      (if (memq function (cdr (car files)))
-         (setq file (car (car files))
-               files nil))
-      (setq files (cdr files)))
-    file))
+(defun describe-symbol-find-file (symbol)
+  (loop for (file . load-data) in load-history
+    do (when (memq symbol load-data)
+        (return file))))
+
 (define-obsolete-function-alias
   'describe-function-find-file
   'describe-symbol-find-file)
@@ -939,8 +948,9 @@ When run interactively, it defaults to any function found by
                         (format (gettext "Describe function (default %s): ")
                                fn)
                         (gettext "Describe function: "))
-                    obarray 'fboundp t nil 'function-history))))
-      (list (if (equal val "") fn (intern val)))))
+                    obarray 'fboundp t nil 'function-history
+                   (symbol-name fn)))))
+      (list (intern val))))
   (with-displaying-help-buffer
    (lambda ()
      (describe-function-1 function)
@@ -1228,8 +1238,9 @@ part of the documentation of internal subroutines."
                    (if v
                        (format "Describe variable (default %s): " v)
                        (gettext "Describe variable: "))
-                   obarray 'boundp t nil 'variable-history))))
-     (list (if (equal val "") v (intern val)))))
+                   obarray 'boundp t nil 'variable-history
+                  (symbol-name v)))))
+     (list (intern val))))
   (with-displaying-help-buffer
    (lambda ()
      (let ((origvar variable)
@@ -1378,10 +1389,6 @@ after the listing is made.)"
               (s (process-status p)))
          (setq tail (cdr tail))
          (princ (format "%-13s" (process-name p)))
-         ;;(if (and (eq system-type 'vax-vms)
-         ;;         (eq s 'signal)
-         ;;        (< (process-exit-status p) NSIG))
-         ;;    (princ (aref sys_errlist (process-exit-status p))))
          (princ s)
          (if (and (eq s 'exit) (/= (process-exit-status p) 0))
              (princ (format " %d" (process-exit-status p))))
@@ -1416,4 +1423,25 @@ after the listing is made.)"
                (if cmd (princ " ")))))
          (terpri))))))
 
+;; Stop gap for 21.0 untill we do help-char etc properly.
+(defun help-keymap-with-help-key (keymap form)
+  "Return a copy of KEYMAP with an help-key binding according to help-char
+ invoking FORM like help-form.  An existing binding is not overridden.
+ If FORM is nil then no binding is made."
+  (let ((map (copy-keymap keymap))
+       (key (if (characterp help-char)
+                (vector (character-to-event help-char))
+              help-char)))
+    (when (and form key (not (lookup-key map key)))
+      (define-key map key
+       `(lambda () (interactive) (help-print-help-form ,form))))
+    map))
+
+(defun help-print-help-form (form)
+  (let ((string (eval form)))
+    (if (stringp string)
+       (with-displaying-help-buffer
+        (insert string)))))
+
+
 ;;; help.el ends here