Show
Ignore:
Timestamp:
2006年09月30日 09時12分06秒 (2 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lisp

    • Property svn:ignore changed from
      *.elc
      MANIFEST
      Makefile
      Makefile.unix
      makefile
      elc.tar.gz
      cus-load.el
      finder-inf.el
      subdirs.el
      loaddefs.el
       to
      *.elc
      MANIFEST
      Makefile
      Makefile.unix
      makefile
      elc.tar.gz
      cus-load.el
      finder-inf.el
      subdirs.el
      loaddefs.el
      pre-mh-loaddefs.el-CMD

  • trunk/lisp/help.el

    r4166 r4169  
    572572           ;; event then is in the second element of the vector. 
    573573           (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))))) 
     574                (let ((last-idx (1- (length key)))) 
     575                  (and (eventp (aref key last-idx)) 
     576                       (memq 'down (event-modifiers (aref key last-idx))))) 
    579577                (read-event)) 
    580578           (list 
    …… 
    595593         (modifiers (event-modifiers event)) 
    596594         (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)))))))) 
     595         (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) 
     596                            (memq 'drag modifiers)) " at that spot" "")) 
     597         (defn (key-binding key t)) 
     598         key-desc) 
     599    ;; Handle the case where we faked an entry in "Select and Paste" menu. 
     600    (if (and (eq defn nil) 
     601             (stringp (aref key (1- (length key)))) 
     602             (eq (key-binding (substring key 0 -1)) 'yank-menu)) 
     603        (setq defn 'menu-bar-select-yank)) 
     604    ;; Don't bother user with strings from (e.g.) the select-paste menu. 
     605    (if (stringp (aref key (1- (length key)))) 
     606        (aset key (1- (length key)) "(any string)")) 
     607    (if (and (> (length untranslated) 0) 
     608             (stringp (aref untranslated (1- (length untranslated))))) 
     609        (aset untranslated (1- (length untranslated)) "(any string)")) 
     610    ;; Now describe the key, perhaps as changed. 
     611    (setq key-desc (help-key-description key untranslated)) 
     612    (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
     613        (princ (format "%s%s is undefined" key-desc mouse-msg)) 
     614      (princ (format "%s%s runs the command %S" key-desc mouse-msg defn))))) 
    624615 
    625616(defun describe-key (&optional key untranslated up-event) 
    …… 
    651642            key 
    652643            (prefix-numeric-value current-prefix-arg) 
    653             ;; If KEY is a down-event, read the corresponding up-event 
    654             ;; and use it as the third argument. 
     644            ;; If KEY is a down-event, read and discard the 
     645            ;; corresponding up-event.  Note that there are also 
     646            ;; down-events on scroll bars and mode lines: the actual 
     647            ;; event then is in the second element of the vector. 
    655648            (and (vectorp key) 
     649                 (let ((last-idx (1- (length key)))) 
     650                   (and (eventp (aref key last-idx)) 
     651                        (memq 'down (event-modifiers (aref key last-idx))))) 
    656652                 (or (and (eventp (aref key 0)) 
    657                           (memq 'down (event-modifiers (aref key 0)))) 
     653                          (memq 'down (event-modifiers (aref key 0))) 
     654                          ;; However, for the C-down-mouse-2 popup 
     655                          ;; menu, there is no subsequent up-event.  In 
     656                          ;; this case, the up-event is the next 
     657                          ;; element in the supplied vector. 
     658                          (= (length key) 1)) 
    658659                     (and (> (length key) 1) 
    659660                          (eventp (aref key 1)) 
    …… 
    672673                            0))) 
    673674         (modifiers (event-modifiers event)) 
    674          (mousep (or (memq 'click modifiers) (memq 'down modifiers) 
    675                      (memq 'drag modifiers))) 
     675         (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) 
     676                           (memq 'drag modifiers)) " at that spot" "")) 
    676677         (defn (key-binding key t)) 
    677678         defn-up defn-up-tricky ev-type 
    …… 
    679680 
    680681    ;; Handle the case where we faked an entry in "Select and Paste" menu. 
    681       (if (and (eq defn nil) 
     682    (when (and (eq defn nil) 
    682683               (stringp (aref key (1- (length key)))) 
    683684               (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 
     685      (setq defn 'menu-bar-select-yank)) 
     686    (if (or (null defn) (integerp defn) (equal defn 'undefined)) 
     687        (message "%s%s is undefined" 
     688                 (help-key-description key untranslated) mouse-msg) 
     689      (help-setup-xref (list #'describe-function defn) (interactive-p)) 
     690      ;; Don't bother user with strings from (e.g.) the select-paste menu. 
     691      (when (stringp (aref key (1- (length key)))) 
     692        (aset key (1- (length key)) "(any string)")) 
     693      (when (and untranslated 
    692694                 (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. 
     695        (aset untranslated (1- (length untranslated)) 
     696              "(any string)")) 
     697      ;; Need to do this before erasing *Help* buffer in case event 
     698      ;; is a mouse click in an existing *Help* buffer. 
     699      (when up-event 
     700        (setq ev-type (event-basic-type up-event)) 
     701        (let ((sequence (vector up-event))) 
     702          (when (and (eq ev-type 'mouse-1) 
     703                     mouse-1-click-follows-link 
     704                     (not (eq mouse-1-click-follows-link 'double)) 
     705                     (setq mouse-1-remapped 
     706                           (mouse-on-link-p (event-start up-event)))) 
     707            (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link) 
     708                                      (> mouse-1-click-follows-link 0))) 
     709            (cond ((stringp mouse-1-remapped) 
     710                   (setq sequence mouse-1-remapped)) 
     711                  ((vectorp mouse-1-remapped) 
     712                   (setcar up-event (elt mouse-1-remapped 0))) 
     713                  (t (setcar up-event 'mouse-2)))) 
     714          (setq defn-up (key-binding sequence nil nil (event-start up-event))) 
     715          (when mouse-1-tricky 
     716            (setq sequence (vector up-event)) 
     717            (aset sequence 0 'mouse-1) 
     718            (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))))) 
     719      (with-output-to-temp-buffer (help-buffer) 
     720        (princ (help-key-description key untranslated)) 
     721        (princ (format "\ 
     722%s runs the command %S 
     723  which is " 
     724                       mouse-msg defn)) 
     725        (describe-function-1 defn) 
    697726        (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 
    753                       (princ " at that spot")) 
    754                   (princ (format " for longer than %d milli-seconds\n" 
    755                                  mouse-1-click-follows-link)) 
    756                   (princ " runs the command ") 
    757                   (prin1 defn) 
    758                   (princ "\n   which is ") 
    759                   (describe-function-1 defn))))) 
    760           (print-help-return-message))))) 
     727          (unless (or (null defn-up) 
     728                      (integerp defn-up) 
     729                      (equal defn-up 'undefined)) 
     730            (princ (format " 
     731 
     732----------------- up-event %s---------------- 
     733 
     734<%S>%s%s runs the command %S 
     735  which is " 
     736                           (if mouse-1-tricky "(short click) " "") 
     737                           ev-type mouse-msg 
     738                           (if mouse-1-remapped 
     739                               " is remapped to <mouse-2>\nwhich" "") 
     740                           defn-up)) 
     741            (describe-function-1 defn-up)) 
     742          (unless (or (null defn-up-tricky) 
     743                      (integerp defn-up-tricky) 
     744                      (eq defn-up-tricky 'undefined)) 
     745            (princ (format " 
     746 
     747----------------- up-event (long click) ---------------- 
     748 
     749Pressing <%S>%s for longer than %d milli-seconds 
     750runs the command %S 
     751  which is " 
     752                           ev-type mouse-msg 
     753                           mouse-1-click-follows-link 
     754                           defn-up-tricky)) 
     755            (describe-function-1 defn-up-tricky))) 
     756        (print-help-return-message))))) 
    761757  
    762758(defun describe-mode (&optional buffer)