(auto-coding-regexp-alist): Add entries

[bpt/emacs.git] / lisp / help.el

diff --git a/lisp/help.el b/lisp/help.el
index 14de292..5eef13f 100644 (file)
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -429,8 +429,9 @@ To record all your input on a file, use `open-dribble-file'."
     (with-current-buffer standard-output
       (goto-char (point-min))
       (while (progn (move-to-column 50) (not (eobp)))
-       (search-forward " " nil t)
-       (insert "\n")))
+        (when (search-forward " " nil t)
+          (delete-char -1))
+        (insert "\n")))
     (print-help-return-message)))
 
 \f
@@ -577,6 +578,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
             (setq saved-yank-menu (copy-sequence yank-menu))
             (menu-bar-update-yank-menu "(any string)" nil))
           (setq key (read-key-sequence "Describe key (or click or menu item): "))
+          ;; If KEY is a down-event, read and discard the
+          ;; corresponding up-event.
+          (if (and (vectorp key)
+                   (eventp (elt key 0))
+                   (memq 'down (event-modifiers (elt key 0))))
+              (read-event))
           (list
            key
            (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
@@ -658,8 +665,9 @@ temporarily enables it to allow getting help on disabled items and buttons."
            (prefix-numeric-value current-prefix-arg)
            ;; If KEY is a down-event, read the corresponding up-event
            ;; and use it as the third argument.
-           (if (and (consp key) (symbolp (car key))
-                    (memq 'down (cdr (get (car key) 'event-symbol-elements))))
+           (if (and (vectorp key)
+                    (eventp (elt key 0))
+                    (memq 'down (event-modifiers (elt key 0))))
                (read-event))))
        ;; Put yank-menu back as it was, if we changed it.
        (when saved-yank-menu
@@ -705,30 +713,34 @@ temporarily enables it to allow getting help on disabled items and buttons."
            (princ "\n   which is ")
            (describe-function-1 defn)
            (when up-event
-             (let ((ev (aref up-event 0))
-                   (descr (key-description up-event))
+             (let ((type (event-basic-type up-event))
                    (hdr "\n\n-------------- up event ---------------\n\n")
-                   defn
+                   defn sequence
                    mouse-1-tricky mouse-1-remapped)
-               (when (and (consp ev)
-                          (eq (car ev) 'mouse-1)
+               (setq sequence (vector up-event))
+               (when (and (eq type 'mouse-1)
                           (windowp window)
                           mouse-1-click-follows-link
                           (not (eq mouse-1-click-follows-link 'double))
-                          (with-current-buffer (window-buffer window)
-                            (mouse-on-link-p (posn-point (event-start ev)))))
-                 (setq mouse-1-tricky (integerp mouse-1-click-follows-link)
-                       mouse-1-remapped (or (not mouse-1-tricky)
-                                            (> mouse-1-click-follows-link 0)))
-                 (if mouse-1-remapped
-                     (setcar ev 'mouse-2)))
-               (setq defn (or (string-key-binding up-event) (key-binding up-event)))
+                          (setq mouse-1-remapped
+                                (with-current-buffer (window-buffer window)
+                                  (mouse-on-link-p (posn-point
+                                                    (event-start up-event))))))
+                 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
+                                           (> mouse-1-click-follows-link 0)))
+                 (cond ((stringp mouse-1-remapped)
+                        (setq sequence mouse-1-remapped))
+                       ((vectorp mouse-1-remapped)
+                        (setcar up-event (elt mouse-1-remapped 0)))
+                       (t (setcar up-event 'mouse-2))))
+               (setq defn (or (string-key-binding sequence)
+                              (key-binding sequence)))
                (unless (or (null defn) (integerp defn) (equal defn 'undefined))
                  (princ (if mouse-1-tricky
                             "\n\n----------------- up-event (short click) ----------------\n\n"
                           hdr))
                  (setq hdr nil)
-                 (princ descr)
+                 (princ (symbol-name type))
                  (if (windowp window)
                      (princ " at that spot"))
                  (if mouse-1-remapped
@@ -738,26 +750,22 @@ temporarily enables it to allow getting help on disabled items and buttons."
                  (princ "\n   which is ")
                  (describe-function-1 defn))
                (when mouse-1-tricky
-                 (setcar ev
-                         (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2))
-                 (setq defn (or (string-key-binding up-event) (key-binding up-event)))
-                 (unless (or (null defn) (integerp defn) (equal defn 'undefined))
+                 (setcar up-event 'mouse-1)
+                 (setq defn (or (string-key-binding (vector up-event))
+                                (key-binding (vector up-event))))
+                 (unless (or (null defn) (integerp defn) (eq defn 'undefined))
                    (princ (or hdr
                               "\n\n----------------- up-event (long click) ----------------\n\n"))
-                   (princ "Pressing ")
-                   (princ descr)
+                   (princ "Pressing mouse-1")
                    (if (windowp window)
                        (princ " at that spot"))
                    (princ (format " for longer than %d milli-seconds\n"
-                                  (abs mouse-1-click-follows-link)))
-                   (if (not mouse-1-remapped)
-                       (princ " remaps it to <mouse-2> which" ))
+                                  mouse-1-click-follows-link))
                    (princ " runs the command ")
                    (prin1 defn)
                    (princ "\n   which is ")
                    (describe-function-1 defn)))))
            (print-help-return-message)))))))
-
 \f
 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.
@@ -972,5 +980,8 @@ out of view."
         (funcall temp-buffer-max-height (current-buffer))
        temp-buffer-max-height))))
 
+\f
+(provide 'help)
+
 ;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
 ;;; help.el ends here