Show
Ignore:
Timestamp:
09/18/06 20:48:14 (2 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lisp/help.el

    r4140 r4166  
    310310of the key sequence that ran this command." 
    311311  (interactive) 
    312   (let* ((key (this-command-keys))) 
     312  (let ((key (this-command-keys))) 
    313313    (describe-bindings 
    314314     (if (stringp key) 
    …… 
    536536  nil) 
    537537 
    538 (defun string-key-binding (key) 
    539   "Value is the binding of KEY in a string. 
    540 If KEY is an event on a string, and that string has a `local-map' 
    541 or `keymap' property, return the binding of KEY in the string's keymap." 
    542   (let* ((defn nil) 
    543          (start (when (vectorp key) 
    544                   (if (memq (aref key 0) 
    545                             '(mode-line header-line left-margin right-margin)) 
    546                       (event-start (aref key 1)) 
    547                     (and (consp (aref key 0)) 
    548                          (event-start (aref key 0)))))) 
    549          (string-info (and (consp start) (nth 4 start)))) 
    550     (when string-info 
    551       (let* ((string (car string-info)) 
    552              (pos (cdr string-info)) 
    553              (local-map (and (>= pos 0) 
    554                              (< pos (length string)) 
    555                              (or (get-text-property pos 'local-map string) 
    556                                  (get-text-property pos 'keymap string))))) 
    557         (setq defn (and local-map (lookup-key local-map key))))) 
    558     defn)) 
    559  
    560538(defun help-key-description (key untranslated) 
    561539  (let ((string (key-description key))) 
    …… 
    590568           (setq key (read-key-sequence "Describe key (or click or menu item): ")) 
    591569           ;; If KEY is a down-event, read and discard the 
    592            ;; corresponding up-event. 
    593            (if (and (vectorp key) 
    594                     (eventp (elt key 0)) 
    595                     (memq 'down (event-modifiers (elt key 0)))) 
    596                (read-event)) 
     570           ;; corresponding up-event.  Note that there are also 
     571           ;; down-events on scroll bars and mode lines: the actual 
     572           ;; event then is in the second element of the vector. 
     573           (and (vectorp key) 
     574                (or (and (eventp (aref key 0)) 
     575                         (memq 'down (event-modifiers (aref key 0)))) 
     576                    (and (> (length key) 1) 
     577                         (eventp (aref key 1)) 
     578                         (memq 'down (event-modifiers (aref key 1))))) 
     579                (read-event)) 
    597580           (list 
    598581            key 
    …… 
    605588  (if (numberp untranslated) 
    606589      (setq untranslated (this-single-command-raw-keys))) 
    607   (save-excursion 
    608     (let ((modifiers (event-modifiers (aref key 0))) 
    609           (standard-output (if insert (current-buffer) t)) 
    610           window position) 
    611       ;; For a mouse button event, go to the button it applies to 
    612       ;; to get the right key bindings.  And go to the right place 
    613       ;; in case the keymap depends on where you clicked. 
    614       (if (or (memq 'click modifiers) (memq 'down modifiers) 
    615               (memq 'drag modifiers)) 
    616           (setq window (posn-window (event-start (aref key 0))) 
    617                 position (posn-point (event-start (aref key 0))))) 
    618       (if (windowp window) 
    619           (progn 
    620             (set-buffer (window-buffer window)) 
    621             (goto-char position))) 
    622       ;; Ok, now look up the key and name the command. 
    623       (let ((defn (or (string-key-binding key) 
    624                       (key-binding key t))) 
    625             key-desc) 
    626         ;; Handle the case where we faked an entry in "Select and Paste" menu. 
    627         (if (and (eq defn nil) 
    628                  (stringp (aref key (1- (length key)))) 
    629                  (eq (key-binding (substring key 0 -1)) 'yank-menu)) 
    630             (setq defn 'menu-bar-select-yank)) 
    631         ;; Don't bother user with strings from (e.g.) the select-paste menu. 
    632         (if (stringp (aref key (1- (length key)))) 
    633             (aset key (1- (length key)) "(any string)")) 
    634         (if (and (> (length untranslated) 0) 
    635                  (stringp (aref untranslated (1- (length untranslated))))) 
    636             (aset untranslated (1- (length untranslated)) 
    637                   "(any string)")) 
    638         ;; Now describe the key, perhaps as changed. 
    639         (setq key-desc (help-key-description key untranslated)) 
    640         (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
    641             (princ (format "%s is undefined" key-desc)) 
    642           (princ (format (if (windowp window) 
    643                              "%s at that spot runs the command %s" 
    644                            "%s runs the command %s") 
    645                          key-desc 
    646                          (if (symbolp defn) defn (prin1-to-string defn))))))))) 
     590  (let* ((event (if (and (symbolp (aref key 0)) 
     591                         (> (length key) 1) 
     592                         (consp (aref key 1))) 
     593                    (aref key 1) 
     594                  (aref key 0))) 
     595         (modifiers (event-modifiers event)) 
     596         (standard-output (if insert (current-buffer) t)) 
     597         (mousep 
     598          (or (memq 'click modifiers) (memq 'down modifiers) 
     599              (memq 'drag modifiers)))) 
     600    ;; Ok, now look up the key and name the command. 
     601    (let ((defn (key-binding key t)) 
     602          key-desc) 
     603      ;; Handle the case where we faked an entry in "Select and Paste" menu. 
     604      (if (and (eq defn nil) 
     605               (stringp (aref key (1- (length key)))) 
     606               (eq (key-binding (substring key 0 -1)) 'yank-menu)) 
     607          (setq defn 'menu-bar-select-yank)) 
     608      ;; Don't bother user with strings from (e.g.) the select-paste menu. 
     609      (if (stringp (aref key (1- (length key)))) 
     610          (aset key (1- (length key)) "(any string)")) 
     611      (if (and (> (length untranslated) 0) 
     612               (stringp (aref untranslated (1- (length untranslated))))) 
     613          (aset untranslated (1- (length untranslated)) 
     614                "(any string)")) 
     615      ;; Now describe the key, perhaps as changed. 
     616      (setq key-desc (help-key-description key untranslated)) 
     617      (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
     618          (princ (format "%s is undefined" key-desc)) 
     619        (princ (format (if mousep 
     620                           "%s at that spot runs the command %s" 
     621                         "%s runs the command %s") 
     622                       key-desc 
     623                       (if (symbolp defn) defn (prin1-to-string defn)))))))) 
    647624 
    648625(defun describe-key (&optional key untranslated up-event) 
    …… 
    676653            ;; If KEY is a down-event, read the corresponding up-event 
    677654            ;; and use it as the third argument. 
    678             (if (and (vectorp key) 
    679                      (eventp (elt key 0)) 
    680                      (memq 'down (event-modifiers (elt key 0)))) 
    681                 (read-event)))) 
     655            (and (vectorp key) 
     656                 (or (and (eventp (aref key 0)) 
     657                          (memq 'down (event-modifiers (aref key 0)))) 
     658                     (and (> (length key) 1) 
     659                          (eventp (aref key 1)) 
     660                          (memq 'down (event-modifiers (aref key 1))))) 
     661                 (read-event)))) 
    682662       ;; Put yank-menu back as it was, if we changed it. 
    683663       (when saved-yank-menu 
    …… 
    686666  (if (numberp untranslated) 
    687667      (setq untranslated (this-single-command-raw-keys))) 
    688   (save-excursion 
    689     (let ((modifiers (event-modifiers (aref key 0))) 
    690           window position) 
    691       ;; For a mouse button event, go to the button it applies to 
    692       ;; to get the right key bindings.  And go to the right place 
    693       ;; in case the keymap depends on where you clicked. 
    694       (if (or (memq 'click modifiers) (memq 'down modifiers) 
    695               (memq 'drag modifiers)) 
    696           (setq window (posn-window (event-start (aref key 0))) 
    697                 position (posn-point (event-start (aref key 0))))) 
    698       (when (windowp window) 
    699             (set-buffer (window-buffer window)) 
    700         (goto-char position)) 
    701       (let ((defn (or (string-key-binding key) (key-binding key t)))) 
    702         ;; Handle the case where we faked an entry in "Select and Paste" menu. 
    703         (if (and (eq defn nil) 
    704                  (stringp (aref key (1- (length key)))) 
    705                  (eq (key-binding (substring key 0 -1)) 'yank-menu)) 
    706             (setq defn 'menu-bar-select-yank)) 
    707         (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
    708             (message "%s is undefined" (help-key-description key untranslated)) 
    709           (help-setup-xref (list #'describe-function defn) (interactive-p)) 
    710           ;; Don't bother user with strings from (e.g.) the select-paste menu. 
    711           (if (stringp (aref key (1- (length key)))) 
    712               (aset key (1- (length key)) "(any string)")) 
    713           (if (and untranslated 
    714                    (stringp (aref untranslated (1- (length untranslated))))) 
    715               (aset untranslated (1- (length untranslated)) 
    716                     "(any string)")) 
    717           (with-output-to-temp-buffer (help-buffer) 
    718             (princ (help-key-description key untranslated)) 
    719             (if (windowp window) 
    720                 (princ " at that spot")) 
    721             (princ " runs the command ") 
    722             (prin1 defn) 
    723             (princ "\n   which is ") 
    724             (describe-function-1 defn) 
    725             (when up-event 
    726               (let ((type (event-basic-type up-event)) 
    727                     (hdr "\n\n-------------- up event ---------------\n\n") 
    728                     defn sequence 
    729                     mouse-1-tricky mouse-1-remapped) 
    730                 (setq sequence (vector up-event)) 
    731                 (when (and (eq type 'mouse-1) 
    732                            (windowp window) 
    733                            mouse-1-click-follows-link 
    734                            (not (eq mouse-1-click-follows-link 'double)) 
    735                            (setq mouse-1-remapped 
    736                                  (with-current-buffer (window-buffer window) 
    737                                    (mouse-on-link-p (posn-point 
    738                                                      (event-start up-event)))))) 
    739                   (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link) 
    740                                             (> mouse-1-click-follows-link 0))) 
    741                   (cond ((stringp mouse-1-remapped) 
    742                          (setq sequence mouse-1-remapped)) 
    743                         ((vectorp mouse-1-remapped) 
    744                          (setcar up-event (elt mouse-1-remapped 0))) 
    745                         (t (setcar up-event 'mouse-2)))) 
    746                 (setq defn (or (string-key-binding sequence) 
    747                                (key-binding sequence))) 
    748                 (unless (or (null defn) (integerp defn) (equal defn 'undefined)) 
    749                   (princ (if mouse-1-tricky 
    750                              "\n\n----------------- up-event (short click) ----------------\n\n" 
    751                            hdr)) 
    752                   (setq hdr nil) 
    753                   (princ (symbol-name type)) 
    754                   (if (windowp window) 
     668  (let* ((event (aref key (if (and (symbolp (aref key 0)) 
     669                                   (> (length key) 1) 
     670                                   (consp (aref key 1))) 
     671                              1 
     672                            0))) 
     673         (modifiers (event-modifiers event)) 
     674         (mousep (or (memq 'click modifiers) (memq 'down modifiers) 
     675                     (memq 'drag modifiers))) 
     676         (defn (key-binding key t)) 
     677         defn-up defn-up-tricky ev-type 
     678         mouse-1-remapped mouse-1-tricky) 
     679 
     680    ;; Handle the case where we faked an entry in "Select and Paste" menu. 
     681      (if (and (eq defn nil) 
     682               (stringp (aref key (1- (length key)))) 
     683               (eq (key-binding (substring key 0 -1)) 'yank-menu)) 
     684          (setq defn 'menu-bar-select-yank)) 
     685      (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
     686          (message "%s is undefined" (help-key-description key untranslated)) 
     687        (help-setup-xref (list #'describe-function defn) (interactive-p)) 
     688        ;; Don't bother user with strings from (e.g.) the select-paste menu. 
     689        (if (stringp (aref key (1- (length key)))) 
     690            (aset key (1- (length key)) "(any string)")) 
     691        (if (and untranslated 
     692                 (stringp (aref untranslated (1- (length untranslated))))) 
     693            (aset untranslated (1- (length untranslated)) 
     694                  "(any string)")) 
     695        ;; Need to do this before erasing *Help* buffer in case event 
     696        ;; is a mouse click in an existing *Help* buffer. 
     697        (when up-event 
     698          (setq ev-type (event-basic-type up-event)) 
     699          (let ((sequence (vector up-event))) 
     700            (when (and (eq ev-type 'mouse-1) 
     701                       mouse-1-click-follows-link 
     702                       (not (eq mouse-1-click-follows-link 'double)) 
     703                       (setq mouse-1-remapped 
     704                             (mouse-on-link-p (event-start up-event)))) 
     705              (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link) 
     706                                        (> mouse-1-click-follows-link 0))) 
     707              (cond ((stringp mouse-1-remapped) 
     708                     (setq sequence mouse-1-remapped)) 
     709                    ((vectorp mouse-1-remapped) 
     710                     (setcar up-event (elt mouse-1-remapped 0))) 
     711                    (t (setcar up-event 'mouse-2)))) 
     712            (setq defn-up (key-binding sequence nil nil (event-start up-event))) 
     713            (when mouse-1-tricky 
     714              (setq sequence (vector up-event)) 
     715              (aset sequence 0 'mouse-1) 
     716              (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))))) 
     717        (with-output-to-temp-buffer (help-buffer) 
     718          (princ (help-key-description key untranslated)) 
     719          (if mousep 
     720              (princ " at that spot")) 
     721          (princ " runs the command ") 
     722          (prin1 defn) 
     723          (princ "\n   which is ") 
     724          (describe-function-1 defn) 
     725          (when up-event 
     726            (let ((hdr "\n\n-------------- up event ---------------\n\n")) 
     727              (setq defn defn-up) 
     728              (unless (or (null defn) 
     729                          (integerp defn) 
     730                          (equal defn 'undefined)) 
     731                (princ (if mouse-1-tricky 
     732                           "\n\n----------------- up-event (short click) ----------------\n\n" 
     733                         hdr)) 
     734                (setq hdr nil) 
     735                (princ (symbol-name ev-type)) 
     736                (if mousep 
     737                    (princ " at that spot")) 
     738                (if mouse-1-remapped 
     739                    (princ " is remapped to <mouse-2>\n  which" )) 
     740                (princ " runs the command ") 
     741                (prin1 defn) 
     742                (princ "\n   which is ") 
     743                (describe-function-1 defn)) 
     744              (when mouse-1-tricky 
     745                (setq defn defn-up-tricky) 
     746                (unless (or (null defn) 
     747                            (integerp defn) 
     748                            (eq defn 'undefined)) 
     749                  (princ (or hdr 
     750                             "\n\n----------------- up-event (long click) ----------------\n\n")) 
     751                  (princ "Pressing mouse-1") 
     752                  (if mousep 
    755753                      (princ " at that spot")) 
    756                   (if mouse-1-remapped 
    757                       (princ " is remapped to <mouse-2>\n  which" )) 
     754                  (princ (format " for longer than %d milli-seconds\n" 
     755                                mouse-1-click-follows-link)) 
    758756                  (princ " runs the command ") 
    759757                  (prin1 defn) 
    760758                  (princ "\n   which is ") 
    761                   (describe-function-1 defn)) 
    762                 (when mouse-1-tricky 
    763                   (setcar up-event 'mouse-1) 
    764                   (setq defn (or (string-key-binding (vector up-event)) 
    765                                  (key-binding (vector up-event)))) 
    766                   (unless (or (null defn) (integerp defn) (eq defn 'undefined)) 
    767                     (princ (or hdr 
    768                                "\n\n----------------- up-event (long click) ----------------\n\n")) 
    769                     (princ "Pressing mouse-1") 
    770                     (if (windowp window) 
    771                         (princ " at that spot")) 
    772                     (princ (format " for longer than %d milli-seconds\n" 
    773                                    mouse-1-click-follows-link)) 
    774                     (princ " runs the command ") 
    775                     (prin1 defn) 
    776                     (princ "\n   which is ") 
    777                     (describe-function-1 defn))))) 
    778             (print-help-return-message))))))) 
     759                  (describe-function-1 defn))))) 
     760          (print-help-return-message))))) 
    779761  
    780762(defun describe-mode (&optional buffer)