Merge branch 'scratch/substitute-command-keys'
This commit is contained in:
Stefan Kangas
commit
558065531b
9 changed files with 925 additions and 830 deletions
470
lisp/help.el
470
lisp/help.el
|
|
@ -973,6 +973,476 @@ is currently activated with completion."
|
|||
minor-modes nil)
|
||||
(setq minor-modes (cdr minor-modes)))))
|
||||
result))
|
||||
|
||||
|
||||
(defun substitute-command-keys (string)
|
||||
"Substitute key descriptions for command names in STRING.
|
||||
Each substring of the form \\\\=[COMMAND] is replaced by either a
|
||||
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
|
||||
is not on any keys.
|
||||
|
||||
Each substring of the form \\\\={MAPVAR} is replaced by a summary of
|
||||
the value of MAPVAR as a keymap. This summary is similar to the one
|
||||
produced by ‘describe-bindings’. The summary ends in two newlines
|
||||
(used by the helper function ‘help-make-xrefs’ to find the end of the
|
||||
summary).
|
||||
|
||||
Each substring of the form \\\\=<MAPVAR> specifies the use of MAPVAR
|
||||
as the keymap for future \\\\=[COMMAND] substrings.
|
||||
|
||||
Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
|
||||
is replaced by right quote. Left and right quote characters are
|
||||
specified by ‘text-quoting-style’.
|
||||
|
||||
\\\\== quotes the following character and is discarded; thus, \\\\==\\\\== puts \\\\==
|
||||
into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` into the
|
||||
output.
|
||||
|
||||
Return the original STRING if no substitutions are made.
|
||||
Otherwise, return a new string (without any text properties)."
|
||||
(when (not (null string))
|
||||
;; KEYMAP is either nil (which means search all the active
|
||||
;; keymaps) or a specified local map (which means search just that
|
||||
;; and the global map). If non-nil, it might come from
|
||||
;; overriding-local-map, or from a \\<mapname> construct in STRING
|
||||
;; itself.
|
||||
(let ((keymap overriding-local-map)
|
||||
(inhibit-modification-hooks t)
|
||||
(orig-buf (current-buffer)))
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(while (< (point) (point-max))
|
||||
(let ((standard-output (current-buffer))
|
||||
(orig-point (point))
|
||||
end-point active-maps
|
||||
close generate-summary)
|
||||
(cond
|
||||
;; 1. Handle all sequences starting with "\"
|
||||
((= (following-char) ?\\)
|
||||
(ignore-errors
|
||||
(forward-char 1))
|
||||
(cond
|
||||
;; 1A. Ignore \= at end of string.
|
||||
((and (= (+ (point) 1) (point-max))
|
||||
(= (following-char) ?=))
|
||||
(forward-char 1))
|
||||
;; 1B. \= quotes the next character; thus, to put in \[
|
||||
;; without its special meaning, use \=\[.
|
||||
((= (following-char) ?=)
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(ignore-errors
|
||||
(forward-char 1)))
|
||||
;; 1C. \[foo] is replaced with the keybinding.
|
||||
((and (= (following-char) ?\[)
|
||||
(save-excursion
|
||||
(prog1 (search-forward "]" nil t)
|
||||
(setq end-point (- (point) 2)))))
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(let* ((fun (intern (buffer-substring (point) (1- end-point))))
|
||||
(key (with-current-buffer orig-buf
|
||||
(where-is-internal fun keymap t))))
|
||||
;; If this a command remap, we need to follow it.
|
||||
(when (and (vectorp key)
|
||||
(> (length key) 1)
|
||||
(eq (aref key 0) 'remap)
|
||||
(symbolp (aref key 1)))
|
||||
(setq fun (aref key 1))
|
||||
(setq key (with-current-buffer orig-buf
|
||||
(where-is-internal fun keymap t))))
|
||||
(if (not key)
|
||||
;; Function is not on any key.
|
||||
(progn (insert "M-x ")
|
||||
(goto-char (+ end-point 3))
|
||||
(delete-char 1))
|
||||
;; Function is on a key.
|
||||
(delete-char (- end-point (point)))
|
||||
(insert (key-description key)))))
|
||||
;; 1D. \{foo} is replaced with a summary of the keymap
|
||||
;; (symbol-value foo).
|
||||
;; \<foo> just sets the keymap used for \[cmd].
|
||||
((and (or (and (= (following-char) ?{)
|
||||
(setq close "}")
|
||||
(setq generate-summary t))
|
||||
(and (= (following-char) ?<)
|
||||
(setq close ">")))
|
||||
(or (save-excursion
|
||||
(prog1 (search-forward close nil t)
|
||||
(setq end-point (- (point) 2))))))
|
||||
(goto-char orig-point)
|
||||
(delete-char 2)
|
||||
(let* ((name (intern (buffer-substring (point) (1- end-point))))
|
||||
this-keymap)
|
||||
(delete-char (- end-point (point)))
|
||||
;; Get the value of the keymap in TEM, or nil if
|
||||
;; undefined. Do this in the user's current buffer
|
||||
;; in case it is a local variable.
|
||||
(with-current-buffer orig-buf
|
||||
;; This is for computing the SHADOWS arg for
|
||||
;; describe-map-tree.
|
||||
(setq active-maps (current-active-maps))
|
||||
(when (boundp name)
|
||||
(setq this-keymap (and (keymapp (symbol-value name))
|
||||
(symbol-value name)))))
|
||||
(cond
|
||||
((null this-keymap)
|
||||
(insert "\nUses keymap "
|
||||
(substitute-command-keys "`")
|
||||
(symbol-name name)
|
||||
(substitute-command-keys "'")
|
||||
", which is not currently defined.\n")
|
||||
(unless generate-summary
|
||||
(setq keymap nil)))
|
||||
((not generate-summary)
|
||||
(setq keymap this-keymap))
|
||||
(t
|
||||
;; Get the list of active keymaps that precede this one.
|
||||
;; If this one's not active, get nil.
|
||||
(let ((earlier-maps (cdr (memq this-keymap (reverse active-maps)))))
|
||||
(describe-map-tree this-keymap t (nreverse earlier-maps)
|
||||
nil nil t nil nil t))))))))
|
||||
;; 2. Handle quotes.
|
||||
((and (eq (get-quoting-style) 'curve)
|
||||
(or (and (= (following-char) ?\`)
|
||||
(prog1 t (insert "‘")))
|
||||
(and (= (following-char) ?')
|
||||
(prog1 t (insert "’")))))
|
||||
(delete-char 1))
|
||||
((and (eq (get-quoting-style) 'straight)
|
||||
(= (following-char) ?\`))
|
||||
(insert "'")
|
||||
(delete-char 1))
|
||||
;; 3. Nothing to do -- next character.
|
||||
(t (forward-char 1)))))
|
||||
(buffer-string)))))
|
||||
|
||||
(defvar help--keymaps-seen nil)
|
||||
(defun describe-map-tree (startmap partial shadow prefix title no-menu
|
||||
transl always-title mention-shadow)
|
||||
"Insert a description of the key bindings in STARTMAP.
|
||||
This is followed by the key bindings of all maps reachable
|
||||
through STARTMAP.
|
||||
|
||||
If PARTIAL is non-nil, omit certain uninteresting commands
|
||||
\(such as `undefined').
|
||||
|
||||
If SHADOW is non-nil, it is a list of maps; don't mention keys
|
||||
which would be shadowed by any of them.
|
||||
|
||||
If PREFIX is non-nil, mention only keys that start with PREFIX.
|
||||
|
||||
If TITLE is non-nil, is a string to insert at the beginning.
|
||||
TITLE should not end with a colon or a newline; we supply that.
|
||||
|
||||
If NOMENU is non-nil, then omit menu-bar commands.
|
||||
|
||||
If TRANSL is non-nil, the definitions are actually key
|
||||
translations so print strings and vectors differently.
|
||||
|
||||
If ALWAYS_TITLE is non-nil, print the title even if there are no
|
||||
maps to look through.
|
||||
|
||||
If MENTION_SHADOW is non-nil, then when something is shadowed by
|
||||
SHADOW, don't omit it; instead, mention it but say it is
|
||||
shadowed.
|
||||
|
||||
Any inserted text ends in two newlines (used by
|
||||
`help-make-xrefs')."
|
||||
(let* ((amaps (accessible-keymaps startmap prefix))
|
||||
(orig-maps (if no-menu
|
||||
(progn
|
||||
;; Delete from MAPS each element that is for
|
||||
;; the menu bar.
|
||||
(let* ((tail amaps)
|
||||
result)
|
||||
(while tail
|
||||
(let ((elem (car tail)))
|
||||
(when (not (and (>= (length (car elem)) 1)
|
||||
(eq (elt (car elem) 0) 'menu-bar)))
|
||||
(setq result (append result (list elem)))))
|
||||
(setq tail (cdr tail)))
|
||||
result))
|
||||
amaps))
|
||||
(maps orig-maps)
|
||||
(print-title (or maps always-title)))
|
||||
;; Print title.
|
||||
(when print-title
|
||||
(princ (concat (if title
|
||||
(concat title
|
||||
(if prefix
|
||||
(concat " Starting With "
|
||||
(key-description prefix)))
|
||||
":\n"))
|
||||
"key binding\n"
|
||||
"--- -------\n")))
|
||||
;; Describe key bindings.
|
||||
(setq help--keymaps-seen nil)
|
||||
(while (consp maps)
|
||||
(let* ((elt (car maps))
|
||||
(elt-prefix (car elt))
|
||||
(sub-shadows (lookup-key shadow elt-prefix t)))
|
||||
(when (if (natnump sub-shadows)
|
||||
(prog1 t (setq sub-shadows nil))
|
||||
;; Describe this map iff elt_prefix is bound to a
|
||||
;; keymap, since otherwise it completely shadows this
|
||||
;; map.
|
||||
(or (keymapp sub-shadows)
|
||||
(null sub-shadows)
|
||||
(consp sub-shadows)
|
||||
(not (keymapp (car sub-shadows)))))
|
||||
;; Maps we have already listed in this loop shadow this map.
|
||||
(let ((tail orig-maps))
|
||||
(while (not (equal tail maps))
|
||||
(when (equal (car (car tail)) elt-prefix)
|
||||
(setq sub-shadows (cons (cdr (car tail)) sub-shadows)))
|
||||
(setq tail (cdr tail))))
|
||||
(describe-map (cdr elt) elt-prefix transl partial
|
||||
sub-shadows no-menu mention-shadow)))
|
||||
(setq maps (cdr maps)))
|
||||
(when print-title
|
||||
(princ "\n"))))
|
||||
|
||||
(defun help--shadow-lookup (keymap key accept-default remap)
|
||||
"Like `lookup-key', but with command remapping.
|
||||
Return nil if the key sequence is too long."
|
||||
;; Converted from shadow_lookup in keymap.c.
|
||||
(let ((value (lookup-key keymap key accept-default)))
|
||||
(cond ((and (fixnump value) (<= 0 value)))
|
||||
((and value remap (symbolp value))
|
||||
(or (command-remapping value nil keymap)
|
||||
value))
|
||||
(t value))))
|
||||
|
||||
(defvar help--previous-description-column 0)
|
||||
(defun help--describe-command (definition)
|
||||
;; Converted from describe_command in keymap.c.
|
||||
;; If column 16 is no good, go to col 32;
|
||||
;; but don't push beyond that--go to next line instead.
|
||||
(let* ((column (current-column))
|
||||
(description-column (cond ((> column 30)
|
||||
(insert "\n")
|
||||
32)
|
||||
((or (> column 14)
|
||||
(and (> column 10)
|
||||
(= help--previous-description-column 32)))
|
||||
32)
|
||||
(t 16))))
|
||||
(indent-to description-column 1)
|
||||
(setq help--previous-description-column description-column)
|
||||
(cond ((symbolp definition)
|
||||
(insert (symbol-name definition) "\n"))
|
||||
((or (stringp definition) (vectorp definition))
|
||||
(insert "Keyboard Macro\n"))
|
||||
((keymapp definition)
|
||||
(insert "Prefix Command\n"))
|
||||
(t (insert "??\n")))))
|
||||
|
||||
(defun help--describe-translation (definition)
|
||||
;; Converted from describe_translation in keymap.c.
|
||||
(indent-to 16 1)
|
||||
(cond ((symbolp definition)
|
||||
(insert (symbol-name definition) "\n"))
|
||||
((or (stringp definition) (vectorp definition))
|
||||
(insert (key-description definition nil) "\n"))
|
||||
((keymapp definition)
|
||||
(insert "Prefix Command\n"))
|
||||
(t (insert "??\n"))))
|
||||
|
||||
(defun help--describe-map-compare (a b)
|
||||
(let ((a (car a))
|
||||
(b (car b)))
|
||||
(cond ((and (fixnump a) (fixnump b)) (< a b))
|
||||
;; ((and (not (fixnump a)) (fixnump b)) nil) ; not needed
|
||||
((and (fixnump a) (not (fixnump b))) t)
|
||||
((and (symbolp a) (symbolp b))
|
||||
;; Sort the keystroke names in the "natural" way, with (for
|
||||
;; instance) "<f2>" coming between "<f1>" and "<f11>".
|
||||
(string-version-lessp (symbol-name a) (symbol-name b)))
|
||||
(t nil))))
|
||||
|
||||
(defun describe-map (map prefix transl partial shadow nomenu mention-shadow)
|
||||
"Describe the contents of keymap MAP.
|
||||
Assume that this keymap itself is reached by the sequence of
|
||||
prefix keys PREFIX (a string or vector).
|
||||
|
||||
TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
|
||||
`describe-map-tree'."
|
||||
;; Converted from describe_map in keymap.c.
|
||||
(let* ((suppress (and partial 'suppress-keymap))
|
||||
(map (keymap-canonicalize map))
|
||||
(tail map)
|
||||
(first t)
|
||||
(describer (if transl
|
||||
#'help--describe-translation
|
||||
#'help--describe-command))
|
||||
done vect)
|
||||
(while (and (consp tail) (not done))
|
||||
(cond ((or (vectorp (car tail)) (char-table-p (car tail)))
|
||||
(help--describe-vector (car tail) prefix describer partial
|
||||
shadow map mention-shadow))
|
||||
((consp (car tail))
|
||||
(let ((event (caar tail))
|
||||
definition this-shadowed)
|
||||
;; Ignore bindings whose "prefix" are not really
|
||||
;; valid events. (We get these in the frames and
|
||||
;; buffers menu.)
|
||||
(and (or (symbolp event) (fixnump event))
|
||||
(not (and nomenu (eq event 'menu-bar)))
|
||||
;; Don't show undefined commands or suppressed
|
||||
;; commands.
|
||||
(setq definition (keymap--get-keyelt (cdr (car tail)) nil))
|
||||
(or (not (symbolp definition))
|
||||
(null (get definition suppress)))
|
||||
;; Don't show a command that isn't really
|
||||
;; visible because a local definition of the
|
||||
;; same key shadows it.
|
||||
(or (not shadow)
|
||||
(let ((tem (help--shadow-lookup shadow (vector event) t nil)))
|
||||
(cond ((null tem) t)
|
||||
;; If both bindings are keymaps,
|
||||
;; this key is a prefix key, so
|
||||
;; don't say it is shadowed.
|
||||
((and (keymapp definition) (keymapp tem)) t)
|
||||
;; Avoid generating duplicate
|
||||
;; entries if the shadowed binding
|
||||
;; has the same definition.
|
||||
((and mention-shadow (not (eq tem definition)))
|
||||
(setq this-shadowed t))
|
||||
(t nil))))
|
||||
(push (list event definition this-shadowed) vect))))
|
||||
((eq (car tail) 'keymap)
|
||||
;; The same keymap might be in the structure twice, if
|
||||
;; we're using an inherited keymap. So skip anything
|
||||
;; we've already encountered.
|
||||
(let ((tem (assq tail help--keymaps-seen)))
|
||||
(if (and (consp tem)
|
||||
(equal (car tem) prefix))
|
||||
(setq done t)
|
||||
(push (cons tail prefix) help--keymaps-seen)))))
|
||||
(setq tail (cdr tail)))
|
||||
;; If we found some sparse map events, sort them.
|
||||
(let ((vect (sort vect 'help--describe-map-compare)))
|
||||
;; Now output them in sorted order.
|
||||
(while vect
|
||||
(let* ((elem (car vect))
|
||||
(start (car elem))
|
||||
(definition (cadr elem))
|
||||
(shadowed (caddr elem))
|
||||
(end start))
|
||||
(when first
|
||||
(setq help--previous-description-column 0)
|
||||
(insert "\n")
|
||||
(setq first nil))
|
||||
;; Find consecutive chars that are identically defined.
|
||||
(when (fixnump start)
|
||||
(while (and (cdr vect)
|
||||
(let ((this-event (caar vect))
|
||||
(this-definition (cadar vect))
|
||||
(this-shadowed (caddar vect))
|
||||
(next-event (caar (cdr vect)))
|
||||
(next-definition (cadar (cdr vect)))
|
||||
(next-shadowed (caddar (cdr vect))))
|
||||
(and (eq next-event (1+ this-event))
|
||||
(equal next-definition this-definition)
|
||||
(eq this-shadowed next-shadowed))))
|
||||
(setq vect (cdr vect))
|
||||
(setq end (caar vect))))
|
||||
;; Now START .. END is the range to describe next.
|
||||
;; Insert the string to describe the event START.
|
||||
(insert (key-description (vector start) prefix))
|
||||
(when (not (eq start end))
|
||||
(insert " .. " (key-description (vector end) prefix)))
|
||||
;; Print a description of the definition of this character.
|
||||
;; Called function will take care of spacing out far enough
|
||||
;; for alignment purposes.
|
||||
(if transl
|
||||
(help--describe-translation definition)
|
||||
(help--describe-command definition))
|
||||
;; Print a description of the definition of this character.
|
||||
;; elt_describer will take care of spacing out far enough for
|
||||
;; alignment purposes.
|
||||
(when shadowed
|
||||
(goto-char (max (1- (point)) (point-min)))
|
||||
(insert "\n (this binding is currently shadowed)")
|
||||
(goto-char (min (1+ (point)) (point-max)))))
|
||||
;; Next item in list.
|
||||
(setq vect (cdr vect))))))
|
||||
|
||||
;;;; This Lisp version is 100 times slower than its C equivalent:
|
||||
;;
|
||||
;; (defun help--describe-vector
|
||||
;; (vector prefix transl partial shadow entire-map mention-shadow)
|
||||
;; "Insert in the current buffer a description of the contents of VECTOR.
|
||||
;;
|
||||
;; PREFIX a prefix key which leads to the keymap that this vector is
|
||||
;; in.
|
||||
;;
|
||||
;; If PARTIAL, it means do not mention suppressed commands
|
||||
;; (that assumes the vector is in a keymap).
|
||||
;;
|
||||
;; SHADOW is a list of keymaps that shadow this map. If it is
|
||||
;; non-nil, look up the key in those maps and don't mention it if it
|
||||
;; is defined by any of them.
|
||||
;;
|
||||
;; ENTIRE-MAP is the vector in which this vector appears.
|
||||
;; If the definition in effect in the whole map does not match
|
||||
;; the one in this vector, we ignore this one."
|
||||
;; ;; Converted from describe_vector in keymap.c.
|
||||
;; (let* ((first t)
|
||||
;; (idx 0))
|
||||
;; (while (< idx (length vector))
|
||||
;; (let* ((val (aref vector idx))
|
||||
;; (definition (keymap--get-keyelt val nil))
|
||||
;; (start-idx idx)
|
||||
;; this-shadowed
|
||||
;; found-range)
|
||||
;; (when (and definition
|
||||
;; ;; Don't mention suppressed commands.
|
||||
;; (not (and partial
|
||||
;; (symbolp definition)
|
||||
;; (get definition 'suppress-keymap)))
|
||||
;; ;; If this binding is shadowed by some other map,
|
||||
;; ;; ignore it.
|
||||
;; (not (and shadow
|
||||
;; (help--shadow-lookup shadow (vector start-idx) t nil)
|
||||
;; (if mention-shadow
|
||||
;; (prog1 nil (setq this-shadowed t))
|
||||
;; t)))
|
||||
;; ;; Ignore this definition if it is shadowed by an earlier
|
||||
;; ;; one in the same keymap.
|
||||
;; (not (and entire-map
|
||||
;; (not (eq (lookup-key entire-map (vector start-idx) t)
|
||||
;; definition)))))
|
||||
;; (when first
|
||||
;; (insert "\n")
|
||||
;; (setq first nil))
|
||||
;; (when (and prefix (> (length prefix) 0))
|
||||
;; (insert (format "%s" prefix)))
|
||||
;; (insert (key-description (vector start-idx) prefix))
|
||||
;; ;; Find all consecutive characters or rows that have the
|
||||
;; ;; same definition.
|
||||
;; (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
|
||||
;; definition)
|
||||
;; (setq found-range t)
|
||||
;; (setq idx (1+ idx)))
|
||||
;; ;; If we have a range of more than one character,
|
||||
;; ;; print where the range reaches to.
|
||||
;; (when found-range
|
||||
;; (insert " .. ")
|
||||
;; (when (and prefix (> (length prefix) 0))
|
||||
;; (insert (format "%s" prefix)))
|
||||
;; (insert (key-description (vector idx) prefix)))
|
||||
;; (if transl
|
||||
;; (help--describe-translation definition)
|
||||
;; (help--describe-command definition))
|
||||
;; (when this-shadowed
|
||||
;; (goto-char (1- (point)))
|
||||
;; (insert " (binding currently shadowed)")
|
||||
;; (goto-char (1+ (point))))))
|
||||
;; (setq idx (1+ idx)))))
|
||||
|
||||
|
||||
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
|
||||
(declare-function x-display-pixel-width "xfns.c" (&optional terminal))
|
||||
|
|
|
|||
321
src/doc.c
321
src/doc.c
|
|
@ -415,7 +415,7 @@ string is passed through `substitute-command-keys'. */)
|
|||
}
|
||||
|
||||
if (NILP (raw))
|
||||
doc = Fsubstitute_command_keys (doc);
|
||||
doc = call1 (Qsubstitute_command_keys, doc);
|
||||
return doc;
|
||||
}
|
||||
|
||||
|
|
@ -472,7 +472,7 @@ aren't strings. */)
|
|||
tem = Feval (tem, Qnil);
|
||||
|
||||
if (NILP (raw) && STRINGP (tem))
|
||||
tem = Fsubstitute_command_keys (tem);
|
||||
tem = call1 (Qsubstitute_command_keys, tem);
|
||||
return tem;
|
||||
}
|
||||
|
||||
|
|
@ -696,315 +696,34 @@ text_quoting_style (void)
|
|||
return CURVE_QUOTING_STYLE;
|
||||
}
|
||||
|
||||
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
|
||||
Ssubstitute_command_keys, 1, 1, 0,
|
||||
doc: /* Substitute key descriptions for command names in STRING.
|
||||
Each substring of the form \\=\\[COMMAND] is replaced by either a
|
||||
keystroke sequence that invokes COMMAND, or "M-x COMMAND" if COMMAND
|
||||
is not on any keys.
|
||||
|
||||
Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
|
||||
the value of MAPVAR as a keymap. This summary is similar to the one
|
||||
produced by `describe-bindings'. The summary ends in two newlines
|
||||
\(used by the helper function `help-make-xrefs' to find the end of the
|
||||
summary).
|
||||
|
||||
Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
|
||||
as the keymap for future \\=\\[COMMAND] substrings.
|
||||
|
||||
Each grave accent \\=` is replaced by left quote, and each apostrophe \\='
|
||||
is replaced by right quote. Left and right quote characters are
|
||||
specified by `text-quoting-style'.
|
||||
|
||||
\\=\\= quotes the following character and is discarded; thus, \\=\\=\\=\\= puts \\=\\=
|
||||
into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and \\=\\=\\=` puts \\=` into the
|
||||
output.
|
||||
|
||||
Return the original STRING if no substitutions are made.
|
||||
Otherwise, return a new string (without any text properties). */)
|
||||
(Lisp_Object string)
|
||||
/* This is just a Lisp wrapper for text_quoting_style above. */
|
||||
DEFUN ("get-quoting-style", Fget_quoting_style,
|
||||
Sget_quoting_style, 0, 0, 0,
|
||||
doc: /* Return the current effective text quoting style.
|
||||
See variable `text-quoting-style'. */)
|
||||
(void)
|
||||
{
|
||||
char *buf;
|
||||
bool changed = false;
|
||||
bool nonquotes_changed = false;
|
||||
unsigned char *strp;
|
||||
char *bufp;
|
||||
ptrdiff_t idx;
|
||||
ptrdiff_t bsize;
|
||||
Lisp_Object tem;
|
||||
Lisp_Object keymap;
|
||||
unsigned char const *start;
|
||||
ptrdiff_t length, length_byte;
|
||||
Lisp_Object name;
|
||||
ptrdiff_t nchars;
|
||||
|
||||
if (NILP (string))
|
||||
return Qnil;
|
||||
|
||||
/* If STRING contains non-ASCII unibyte data, process its
|
||||
properly-encoded multibyte equivalent instead. This simplifies
|
||||
the implementation and is OK since substitute-command-keys is
|
||||
intended for use only on text strings. Keep STRING around, since
|
||||
it will be returned if no changes occur. */
|
||||
Lisp_Object str = Fstring_make_multibyte (string);
|
||||
|
||||
enum text_quoting_style quoting_style = text_quoting_style ();
|
||||
|
||||
nchars = 0;
|
||||
|
||||
/* KEYMAP is either nil (which means search all the active keymaps)
|
||||
or a specified local map (which means search just that and the
|
||||
global map). If non-nil, it might come from Voverriding_local_map,
|
||||
or from a \\<mapname> construct in STRING itself.. */
|
||||
keymap = Voverriding_local_map;
|
||||
|
||||
ptrdiff_t strbytes = SBYTES (str);
|
||||
bsize = strbytes;
|
||||
|
||||
/* Fixed-size stack buffer. */
|
||||
char sbuf[MAX_ALLOCA];
|
||||
|
||||
/* Heap-allocated buffer, if any. */
|
||||
char *abuf;
|
||||
|
||||
/* Extra room for expansion due to replacing ‘\[]’ with ‘M-x ’. */
|
||||
enum { EXTRA_ROOM = sizeof "M-x " - sizeof "\\[]" };
|
||||
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
|
||||
if (bsize <= sizeof sbuf - EXTRA_ROOM)
|
||||
switch (text_quoting_style ())
|
||||
{
|
||||
abuf = NULL;
|
||||
buf = sbuf;
|
||||
bsize = sizeof sbuf;
|
||||
case STRAIGHT_QUOTING_STYLE:
|
||||
return Qstraight;
|
||||
case CURVE_QUOTING_STYLE:
|
||||
return Qcurve;
|
||||
case GRAVE_QUOTING_STYLE:
|
||||
default:
|
||||
return Qgrave;
|
||||
}
|
||||
else
|
||||
{
|
||||
buf = abuf = xpalloc (NULL, &bsize, EXTRA_ROOM, STRING_BYTES_BOUND, 1);
|
||||
record_unwind_protect_ptr (xfree, abuf);
|
||||
}
|
||||
bufp = buf;
|
||||
|
||||
strp = SDATA (str);
|
||||
while (strp < SDATA (str) + strbytes)
|
||||
{
|
||||
unsigned char *close_bracket;
|
||||
|
||||
if (strp[0] == '\\' && strp[1] == '='
|
||||
&& strp + 2 < SDATA (str) + strbytes)
|
||||
{
|
||||
/* \= quotes the next character;
|
||||
thus, to put in \[ without its special meaning, use \=\[. */
|
||||
changed = nonquotes_changed = true;
|
||||
strp += 2;
|
||||
/* Fall through to copy one char. */
|
||||
}
|
||||
else if (strp[0] == '\\' && strp[1] == '['
|
||||
&& (close_bracket
|
||||
= memchr (strp + 2, ']',
|
||||
SDATA (str) + strbytes - (strp + 2))))
|
||||
{
|
||||
bool follow_remap = 1;
|
||||
|
||||
start = strp + 2;
|
||||
length_byte = close_bracket - start;
|
||||
idx = close_bracket + 1 - SDATA (str);
|
||||
|
||||
name = Fintern (make_string ((char *) start, length_byte), Qnil);
|
||||
|
||||
do_remap:
|
||||
tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
|
||||
|
||||
if (VECTORP (tem) && ASIZE (tem) > 1
|
||||
&& EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
|
||||
&& follow_remap)
|
||||
{
|
||||
name = AREF (tem, 1);
|
||||
follow_remap = 0;
|
||||
goto do_remap;
|
||||
}
|
||||
|
||||
/* Fwhere_is_internal can GC, so take relocation of string
|
||||
contents into account. */
|
||||
strp = SDATA (str) + idx;
|
||||
start = strp - length_byte - 1;
|
||||
|
||||
if (NILP (tem)) /* but not on any keys */
|
||||
{
|
||||
memcpy (bufp, "M-x ", 4);
|
||||
bufp += 4;
|
||||
nchars += 4;
|
||||
length = multibyte_chars_in_text (start, length_byte);
|
||||
goto subst;
|
||||
}
|
||||
else
|
||||
{ /* function is on a key */
|
||||
tem = Fkey_description (tem, Qnil);
|
||||
goto subst_string;
|
||||
}
|
||||
}
|
||||
/* \{foo} is replaced with a summary of the keymap (symbol-value foo).
|
||||
\<foo> just sets the keymap used for \[cmd]. */
|
||||
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')
|
||||
&& (close_bracket
|
||||
= memchr (strp + 2, strp[1] == '{' ? '}' : '>',
|
||||
SDATA (str) + strbytes - (strp + 2))))
|
||||
{
|
||||
{
|
||||
bool generate_summary = strp[1] == '{';
|
||||
/* This is for computing the SHADOWS arg for describe_map_tree. */
|
||||
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
|
||||
start = strp + 2;
|
||||
length_byte = close_bracket - start;
|
||||
idx = close_bracket + 1 - SDATA (str);
|
||||
|
||||
/* Get the value of the keymap in TEM, or nil if undefined.
|
||||
Do this while still in the user's current buffer
|
||||
in case it is a local variable. */
|
||||
name = Fintern (make_string ((char *) start, length_byte), Qnil);
|
||||
tem = Fboundp (name);
|
||||
if (! NILP (tem))
|
||||
{
|
||||
tem = Fsymbol_value (name);
|
||||
if (! NILP (tem))
|
||||
tem = get_keymap (tem, 0, 1);
|
||||
}
|
||||
|
||||
/* Now switch to a temp buffer. */
|
||||
struct buffer *oldbuf = current_buffer;
|
||||
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
|
||||
/* This is for an unusual case where some after-change
|
||||
function uses 'format' or 'prin1' or something else that
|
||||
will thrash Vprin1_to_string_buffer we are using. */
|
||||
specbind (Qinhibit_modification_hooks, Qt);
|
||||
|
||||
if (NILP (tem))
|
||||
{
|
||||
name = Fsymbol_name (name);
|
||||
AUTO_STRING (msg_prefix, "\nUses keymap `");
|
||||
insert1 (Fsubstitute_command_keys (msg_prefix));
|
||||
insert_from_string (name, 0, 0,
|
||||
SCHARS (name),
|
||||
SBYTES (name), 1);
|
||||
AUTO_STRING (msg_suffix, "', which is not currently defined.\n");
|
||||
insert1 (Fsubstitute_command_keys (msg_suffix));
|
||||
if (!generate_summary)
|
||||
keymap = Qnil;
|
||||
}
|
||||
else if (!generate_summary)
|
||||
keymap = tem;
|
||||
else
|
||||
{
|
||||
/* Get the list of active keymaps that precede this one.
|
||||
If this one's not active, get nil. */
|
||||
Lisp_Object earlier_maps
|
||||
= Fcdr (Fmemq (tem, Freverse (active_maps)));
|
||||
describe_map_tree (tem, 1, Fnreverse (earlier_maps),
|
||||
Qnil, 0, 1, 0, 0, 1);
|
||||
}
|
||||
tem = Fbuffer_string ();
|
||||
Ferase_buffer ();
|
||||
set_buffer_internal (oldbuf);
|
||||
unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
subst_string:
|
||||
/* Convert non-ASCII unibyte data to properly-encoded multibyte,
|
||||
for the same reason STRING was converted to STR. */
|
||||
tem = Fstring_make_multibyte (tem);
|
||||
start = SDATA (tem);
|
||||
length = SCHARS (tem);
|
||||
length_byte = SBYTES (tem);
|
||||
subst:
|
||||
nonquotes_changed = true;
|
||||
subst_quote:
|
||||
changed = true;
|
||||
{
|
||||
ptrdiff_t offset = bufp - buf;
|
||||
ptrdiff_t avail = bsize - offset;
|
||||
ptrdiff_t need = strbytes - idx;
|
||||
if (INT_ADD_WRAPV (need, length_byte + EXTRA_ROOM, &need))
|
||||
string_overflow ();
|
||||
if (avail < need)
|
||||
{
|
||||
abuf = xpalloc (abuf, &bsize, need - avail,
|
||||
STRING_BYTES_BOUND, 1);
|
||||
if (buf == sbuf)
|
||||
{
|
||||
record_unwind_protect_ptr (xfree, abuf);
|
||||
memcpy (abuf, sbuf, offset);
|
||||
}
|
||||
else
|
||||
set_unwind_protect_ptr (count, xfree, abuf);
|
||||
buf = abuf;
|
||||
bufp = buf + offset;
|
||||
}
|
||||
memcpy (bufp, start, length_byte);
|
||||
bufp += length_byte;
|
||||
nchars += length;
|
||||
|
||||
/* Some of the previous code can GC, so take relocation of
|
||||
string contents into account. */
|
||||
strp = SDATA (str) + idx;
|
||||
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else if ((strp[0] == '`' || strp[0] == '\'')
|
||||
&& quoting_style == CURVE_QUOTING_STYLE)
|
||||
{
|
||||
start = (unsigned char const *) (strp[0] == '`' ? uLSQM : uRSQM);
|
||||
length = 1;
|
||||
length_byte = sizeof uLSQM - 1;
|
||||
idx = strp - SDATA (str) + 1;
|
||||
goto subst_quote;
|
||||
}
|
||||
else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
|
||||
{
|
||||
*bufp++ = '\'';
|
||||
strp++;
|
||||
nchars++;
|
||||
changed = true;
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Copy one char. */
|
||||
do
|
||||
*bufp++ = *strp++;
|
||||
while (! CHAR_HEAD_P (*strp));
|
||||
nchars++;
|
||||
}
|
||||
|
||||
if (changed) /* don't bother if nothing substituted */
|
||||
{
|
||||
tem = make_string_from_bytes (buf, nchars, bufp - buf);
|
||||
if (!nonquotes_changed)
|
||||
{
|
||||
/* Nothing has changed other than quoting, so copy the string’s
|
||||
text properties. FIXME: Text properties should survive other
|
||||
changes too; see bug#17052. */
|
||||
INTERVAL interval_copy = copy_intervals (string_intervals (string),
|
||||
0, SCHARS (string));
|
||||
if (interval_copy)
|
||||
{
|
||||
set_interval_object (interval_copy, tem);
|
||||
set_string_intervals (tem, interval_copy);
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
tem = string;
|
||||
return unbind_to (count, tem);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
syms_of_doc (void)
|
||||
{
|
||||
DEFSYM (Qsubstitute_command_keys, "substitute-command-keys");
|
||||
DEFSYM (Qfunction_documentation, "function-documentation");
|
||||
DEFSYM (Qgrave, "grave");
|
||||
DEFSYM (Qstraight, "straight");
|
||||
DEFSYM (Qcurve, "curve");
|
||||
|
||||
DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
|
||||
doc: /* Name of file containing documentation strings of built-in symbols. */);
|
||||
|
|
@ -1036,5 +755,5 @@ otherwise. */);
|
|||
defsubr (&Sdocumentation);
|
||||
defsubr (&Sdocumentation_property);
|
||||
defsubr (&Ssnarf_documentation);
|
||||
defsubr (&Ssubstitute_command_keys);
|
||||
defsubr (&Sget_quoting_style);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2040,7 +2040,7 @@ help_echo_substitute_command_keys (Lisp_Object help)
|
|||
help)))
|
||||
return help;
|
||||
|
||||
return Fsubstitute_command_keys (help);
|
||||
return call1 (Qsubstitute_command_keys, help);
|
||||
}
|
||||
|
||||
/* Display the help-echo property of the character after the mouse pointer.
|
||||
|
|
@ -7856,7 +7856,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
|
|||
/* The previous code preferred :key-sequence to :keys, so we
|
||||
preserve this behavior. */
|
||||
if (STRINGP (keyeq) && !CONSP (keyhint))
|
||||
keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
|
||||
keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq));
|
||||
else
|
||||
{
|
||||
Lisp_Object prefix = keyeq;
|
||||
|
|
|
|||
546
src/keymap.c
546
src/keymap.c
|
|
@ -89,11 +89,6 @@ static Lisp_Object where_is_cache_keymaps;
|
|||
static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
|
||||
|
||||
static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
|
||||
static void describe_command (Lisp_Object, Lisp_Object);
|
||||
static void describe_translation (Lisp_Object, Lisp_Object);
|
||||
static void describe_map (Lisp_Object, Lisp_Object,
|
||||
void (*) (Lisp_Object, Lisp_Object),
|
||||
bool, Lisp_Object, Lisp_Object *, bool, bool);
|
||||
static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
|
||||
void (*) (Lisp_Object, Lisp_Object), bool,
|
||||
Lisp_Object, Lisp_Object, bool, bool);
|
||||
|
|
@ -679,6 +674,23 @@ usage: (map-keymap FUNCTION KEYMAP) */)
|
|||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("keymap--get-keyelt", Fkeymap__get_keyelt, Skeymap__get_keyelt, 2, 2, 0,
|
||||
doc: /* Given OBJECT which was found in a slot in a keymap,
|
||||
trace indirect definitions to get the actual definition of that slot.
|
||||
An indirect definition is a list of the form
|
||||
(KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
|
||||
and INDEX is the object to look up in KEYMAP to yield the definition.
|
||||
|
||||
Also if OBJECT has a menu string as the first element,
|
||||
remove that. Also remove a menu help string as second element.
|
||||
|
||||
If AUTOLOAD, load autoloadable keymaps
|
||||
that are referred to with indirection. */)
|
||||
(Lisp_Object object, Lisp_Object autoload)
|
||||
{
|
||||
return get_keyelt (object, NILP (autoload) ? false : true);
|
||||
}
|
||||
|
||||
/* Given OBJECT which was found in a slot in a keymap,
|
||||
trace indirect definitions to get the actual definition of that slot.
|
||||
An indirect definition is a list of the form
|
||||
|
|
@ -2733,7 +2745,7 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
|
|||
(Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
|
||||
{
|
||||
Lisp_Object outbuf, shadow;
|
||||
bool nomenu = NILP (menus);
|
||||
Lisp_Object nomenu = NILP (menus) ? Qt : Qnil;
|
||||
Lisp_Object start1;
|
||||
|
||||
const char *alternate_heading
|
||||
|
|
@ -2782,9 +2794,13 @@ You type Translation\n\
|
|||
}
|
||||
|
||||
if (!NILP (Vkey_translation_map))
|
||||
describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
|
||||
"Key translations", nomenu, 1, 0, 0);
|
||||
|
||||
{
|
||||
Lisp_Object msg = build_unibyte_string ("Key translations");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
Vkey_translation_map, Qnil, Qnil, prefix,
|
||||
msg, nomenu, Qt, Qnil, Qnil);
|
||||
}
|
||||
|
||||
/* Print the (major mode) local map. */
|
||||
start1 = Qnil;
|
||||
|
|
@ -2793,8 +2809,11 @@ You type Translation\n\
|
|||
|
||||
if (!NILP (start1))
|
||||
{
|
||||
describe_map_tree (start1, 1, shadow, prefix,
|
||||
"\f\nOverriding Bindings", nomenu, 0, 0, 0);
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
start1, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
shadow = Fcons (start1, shadow);
|
||||
start1 = Qnil;
|
||||
}
|
||||
|
|
@ -2803,8 +2822,11 @@ You type Translation\n\
|
|||
|
||||
if (!NILP (start1))
|
||||
{
|
||||
describe_map_tree (start1, 1, shadow, prefix,
|
||||
"\f\nOverriding Bindings", nomenu, 0, 0, 0);
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nOverriding Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
start1, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
shadow = Fcons (start1, shadow);
|
||||
}
|
||||
else
|
||||
|
|
@ -2824,9 +2846,11 @@ You type Translation\n\
|
|||
XBUFFER (buffer), Qkeymap);
|
||||
if (!NILP (start1))
|
||||
{
|
||||
describe_map_tree (start1, 1, shadow, prefix,
|
||||
"\f\n`keymap' Property Bindings", nomenu,
|
||||
0, 0, 0);
|
||||
Lisp_Object msg = build_unibyte_string ("\f\n`keymap' Property Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
start1, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
shadow = Fcons (start1, shadow);
|
||||
}
|
||||
|
||||
|
|
@ -2835,7 +2859,7 @@ You type Translation\n\
|
|||
{
|
||||
/* The title for a minor mode keymap
|
||||
is constructed at run time.
|
||||
We let describe_map_tree do the actual insertion
|
||||
We let describe-map-tree do the actual insertion
|
||||
because it takes care of other features when doing so. */
|
||||
char *title, *p;
|
||||
|
||||
|
|
@ -2855,8 +2879,11 @@ You type Translation\n\
|
|||
p += strlen (" Minor Mode Bindings");
|
||||
*p = 0;
|
||||
|
||||
describe_map_tree (maps[i], 1, shadow, prefix,
|
||||
title, nomenu, 0, 0, 0);
|
||||
Lisp_Object msg = build_unibyte_string (title);
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
maps[i], Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
shadow = Fcons (maps[i], shadow);
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
|
@ -2866,426 +2893,54 @@ You type Translation\n\
|
|||
if (!NILP (start1))
|
||||
{
|
||||
if (EQ (start1, BVAR (XBUFFER (buffer), keymap)))
|
||||
describe_map_tree (start1, 1, shadow, prefix,
|
||||
"\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
|
||||
{
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nMajor Mode Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
start1, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
}
|
||||
else
|
||||
describe_map_tree (start1, 1, shadow, prefix,
|
||||
"\f\n`local-map' Property Bindings",
|
||||
nomenu, 0, 0, 0);
|
||||
{
|
||||
Lisp_Object msg = build_unibyte_string ("\f\n`local-map' Property Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
start1, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qnil, Qnil);
|
||||
}
|
||||
|
||||
shadow = Fcons (start1, shadow);
|
||||
}
|
||||
}
|
||||
|
||||
describe_map_tree (current_global_map, 1, shadow, prefix,
|
||||
"\f\nGlobal Bindings", nomenu, 0, 1, 0);
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nGlobal Bindings");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
current_global_map, Qt, shadow, prefix,
|
||||
msg, nomenu, Qnil, Qt, Qnil);
|
||||
|
||||
/* Print the function-key-map translations under this prefix. */
|
||||
if (!NILP (KVAR (current_kboard, Vlocal_function_key_map)))
|
||||
describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix,
|
||||
"\f\nFunction key map translations", nomenu, 1, 0, 0);
|
||||
{
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nFunction key map translations");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix,
|
||||
msg, nomenu, Qt, Qt, Qt);
|
||||
}
|
||||
|
||||
/* Print the input-decode-map translations under this prefix. */
|
||||
if (!NILP (KVAR (current_kboard, Vinput_decode_map)))
|
||||
describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
|
||||
"\f\nInput decoding map translations", nomenu, 1, 0, 0);
|
||||
|
||||
{
|
||||
Lisp_Object msg = build_unibyte_string ("\f\nInput decoding map translations");
|
||||
CALLN (Ffuncall,
|
||||
Qdescribe_map_tree,
|
||||
KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix,
|
||||
msg, nomenu, Qt, Qnil, Qnil);
|
||||
}
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
/* Insert a description of the key bindings in STARTMAP,
|
||||
followed by those of all maps reachable through STARTMAP.
|
||||
If PARTIAL, omit certain "uninteresting" commands
|
||||
(such as `undefined').
|
||||
If SHADOW is non-nil, it is a list of maps;
|
||||
don't mention keys which would be shadowed by any of them.
|
||||
PREFIX, if non-nil, says mention only keys that start with PREFIX.
|
||||
TITLE, if not 0, is a string to insert at the beginning.
|
||||
TITLE should not end with a colon or a newline; we supply that.
|
||||
If NOMENU, then omit menu-bar commands.
|
||||
|
||||
If TRANSL, the definitions are actually key translations
|
||||
so print strings and vectors differently.
|
||||
|
||||
If ALWAYS_TITLE, print the title even if there are no maps
|
||||
to look through.
|
||||
|
||||
If MENTION_SHADOW, then when something is shadowed by SHADOW,
|
||||
don't omit it; instead, mention it but say it is shadowed.
|
||||
|
||||
Any inserted text ends in two newlines (used by `help-make-xrefs'). */
|
||||
|
||||
void
|
||||
describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
|
||||
Lisp_Object prefix, const char *title, bool nomenu,
|
||||
bool transl, bool always_title, bool mention_shadow)
|
||||
{
|
||||
Lisp_Object maps, orig_maps, seen, sub_shadows;
|
||||
bool something = 0;
|
||||
const char *key_heading
|
||||
= "\
|
||||
key binding\n\
|
||||
--- -------\n";
|
||||
|
||||
orig_maps = maps = Faccessible_keymaps (startmap, prefix);
|
||||
seen = Qnil;
|
||||
sub_shadows = Qnil;
|
||||
|
||||
if (nomenu)
|
||||
{
|
||||
Lisp_Object list;
|
||||
|
||||
/* Delete from MAPS each element that is for the menu bar. */
|
||||
for (list = maps; CONSP (list); list = XCDR (list))
|
||||
{
|
||||
Lisp_Object elt, elt_prefix, tem;
|
||||
|
||||
elt = XCAR (list);
|
||||
elt_prefix = Fcar (elt);
|
||||
if (ASIZE (elt_prefix) >= 1)
|
||||
{
|
||||
tem = Faref (elt_prefix, make_fixnum (0));
|
||||
if (EQ (tem, Qmenu_bar))
|
||||
maps = Fdelq (elt, maps);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (!NILP (maps) || always_title)
|
||||
{
|
||||
if (title)
|
||||
{
|
||||
insert_string (title);
|
||||
if (!NILP (prefix))
|
||||
{
|
||||
insert_string (" Starting With ");
|
||||
insert1 (Fkey_description (prefix, Qnil));
|
||||
}
|
||||
insert_string (":\n");
|
||||
}
|
||||
insert_string (key_heading);
|
||||
something = 1;
|
||||
}
|
||||
|
||||
for (; CONSP (maps); maps = XCDR (maps))
|
||||
{
|
||||
register Lisp_Object elt, elt_prefix, tail;
|
||||
|
||||
elt = XCAR (maps);
|
||||
elt_prefix = Fcar (elt);
|
||||
|
||||
sub_shadows = Flookup_key (shadow, elt_prefix, Qt);
|
||||
if (FIXNATP (sub_shadows))
|
||||
sub_shadows = Qnil;
|
||||
else if (!KEYMAPP (sub_shadows)
|
||||
&& !NILP (sub_shadows)
|
||||
&& !(CONSP (sub_shadows)
|
||||
&& KEYMAPP (XCAR (sub_shadows))))
|
||||
/* If elt_prefix is bound to something that's not a keymap,
|
||||
it completely shadows this map, so don't
|
||||
describe this map at all. */
|
||||
goto skip;
|
||||
|
||||
/* Maps we have already listed in this loop shadow this map. */
|
||||
for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
|
||||
{
|
||||
Lisp_Object tem;
|
||||
tem = Fequal (Fcar (XCAR (tail)), elt_prefix);
|
||||
if (!NILP (tem))
|
||||
sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
|
||||
}
|
||||
|
||||
describe_map (Fcdr (elt), elt_prefix,
|
||||
transl ? describe_translation : describe_command,
|
||||
partial, sub_shadows, &seen, nomenu, mention_shadow);
|
||||
|
||||
skip: ;
|
||||
}
|
||||
|
||||
if (something)
|
||||
insert_string ("\n");
|
||||
}
|
||||
|
||||
static int previous_description_column;
|
||||
|
||||
static void
|
||||
describe_command (Lisp_Object definition, Lisp_Object args)
|
||||
{
|
||||
register Lisp_Object tem1;
|
||||
ptrdiff_t column = current_column ();
|
||||
int description_column;
|
||||
|
||||
/* If column 16 is no good, go to col 32;
|
||||
but don't push beyond that--go to next line instead. */
|
||||
if (column > 30)
|
||||
{
|
||||
insert_char ('\n');
|
||||
description_column = 32;
|
||||
}
|
||||
else if (column > 14 || (column > 10 && previous_description_column == 32))
|
||||
description_column = 32;
|
||||
else
|
||||
description_column = 16;
|
||||
|
||||
Findent_to (make_fixnum (description_column), make_fixnum (1));
|
||||
previous_description_column = description_column;
|
||||
|
||||
if (SYMBOLP (definition))
|
||||
{
|
||||
tem1 = SYMBOL_NAME (definition);
|
||||
insert1 (tem1);
|
||||
insert_string ("\n");
|
||||
}
|
||||
else if (STRINGP (definition) || VECTORP (definition))
|
||||
insert_string ("Keyboard Macro\n");
|
||||
else if (KEYMAPP (definition))
|
||||
insert_string ("Prefix Command\n");
|
||||
else
|
||||
insert_string ("??\n");
|
||||
}
|
||||
|
||||
static void
|
||||
describe_translation (Lisp_Object definition, Lisp_Object args)
|
||||
{
|
||||
register Lisp_Object tem1;
|
||||
|
||||
Findent_to (make_fixnum (16), make_fixnum (1));
|
||||
|
||||
if (SYMBOLP (definition))
|
||||
{
|
||||
tem1 = SYMBOL_NAME (definition);
|
||||
insert1 (tem1);
|
||||
insert_string ("\n");
|
||||
}
|
||||
else if (STRINGP (definition) || VECTORP (definition))
|
||||
{
|
||||
insert1 (Fkey_description (definition, Qnil));
|
||||
insert_string ("\n");
|
||||
}
|
||||
else if (KEYMAPP (definition))
|
||||
insert_string ("Prefix Command\n");
|
||||
else
|
||||
insert_string ("??\n");
|
||||
}
|
||||
|
||||
/* describe_map puts all the usable elements of a sparse keymap
|
||||
into an array of `struct describe_map_elt',
|
||||
then sorts them by the events. */
|
||||
|
||||
struct describe_map_elt
|
||||
{
|
||||
Lisp_Object event;
|
||||
Lisp_Object definition;
|
||||
bool shadowed;
|
||||
};
|
||||
|
||||
/* qsort comparison function for sorting `struct describe_map_elt' by
|
||||
the event field. */
|
||||
|
||||
static int
|
||||
describe_map_compare (const void *aa, const void *bb)
|
||||
{
|
||||
const struct describe_map_elt *a = aa, *b = bb;
|
||||
if (FIXNUMP (a->event) && FIXNUMP (b->event))
|
||||
return ((XFIXNUM (a->event) > XFIXNUM (b->event))
|
||||
- (XFIXNUM (a->event) < XFIXNUM (b->event)));
|
||||
if (!FIXNUMP (a->event) && FIXNUMP (b->event))
|
||||
return 1;
|
||||
if (FIXNUMP (a->event) && !FIXNUMP (b->event))
|
||||
return -1;
|
||||
if (SYMBOLP (a->event) && SYMBOLP (b->event))
|
||||
/* Sort the keystroke names in the "natural" way, with (for
|
||||
instance) "<f2>" coming between "<f1>" and "<f11>". */
|
||||
return string_version_cmp (SYMBOL_NAME (a->event), SYMBOL_NAME (b->event));
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Describe the contents of map MAP, assuming that this map itself is
|
||||
reached by the sequence of prefix keys PREFIX (a string or vector).
|
||||
PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
|
||||
|
||||
static void
|
||||
describe_map (Lisp_Object map, Lisp_Object prefix,
|
||||
void (*elt_describer) (Lisp_Object, Lisp_Object),
|
||||
bool partial, Lisp_Object shadow,
|
||||
Lisp_Object *seen, bool nomenu, bool mention_shadow)
|
||||
{
|
||||
Lisp_Object tail, definition, event;
|
||||
Lisp_Object tem;
|
||||
Lisp_Object suppress;
|
||||
Lisp_Object kludge;
|
||||
bool first = 1;
|
||||
|
||||
/* These accumulate the values from sparse keymap bindings,
|
||||
so we can sort them and handle them in order. */
|
||||
ptrdiff_t length_needed = 0;
|
||||
struct describe_map_elt *vect;
|
||||
ptrdiff_t slots_used = 0;
|
||||
ptrdiff_t i;
|
||||
|
||||
suppress = Qnil;
|
||||
|
||||
if (partial)
|
||||
suppress = intern ("suppress-keymap");
|
||||
|
||||
/* This vector gets used to present single keys to Flookup_key. Since
|
||||
that is done once per keymap element, we don't want to cons up a
|
||||
fresh vector every time. */
|
||||
kludge = make_nil_vector (1);
|
||||
definition = Qnil;
|
||||
|
||||
map = call1 (Qkeymap_canonicalize, map);
|
||||
|
||||
for (tail = map; CONSP (tail); tail = XCDR (tail))
|
||||
length_needed++;
|
||||
|
||||
USE_SAFE_ALLOCA;
|
||||
SAFE_NALLOCA (vect, 1, length_needed);
|
||||
|
||||
for (tail = map; CONSP (tail); tail = XCDR (tail))
|
||||
{
|
||||
maybe_quit ();
|
||||
|
||||
if (VECTORP (XCAR (tail))
|
||||
|| CHAR_TABLE_P (XCAR (tail)))
|
||||
describe_vector (XCAR (tail),
|
||||
prefix, Qnil, elt_describer, partial, shadow, map,
|
||||
1, mention_shadow);
|
||||
else if (CONSP (XCAR (tail)))
|
||||
{
|
||||
bool this_shadowed = 0;
|
||||
|
||||
event = XCAR (XCAR (tail));
|
||||
|
||||
/* Ignore bindings whose "prefix" are not really valid events.
|
||||
(We get these in the frames and buffers menu.) */
|
||||
if (!(SYMBOLP (event) || FIXNUMP (event)))
|
||||
continue;
|
||||
|
||||
if (nomenu && EQ (event, Qmenu_bar))
|
||||
continue;
|
||||
|
||||
definition = get_keyelt (XCDR (XCAR (tail)), 0);
|
||||
|
||||
/* Don't show undefined commands or suppressed commands. */
|
||||
if (NILP (definition)) continue;
|
||||
if (SYMBOLP (definition) && partial)
|
||||
{
|
||||
tem = Fget (definition, suppress);
|
||||
if (!NILP (tem))
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Don't show a command that isn't really visible
|
||||
because a local definition of the same key shadows it. */
|
||||
|
||||
ASET (kludge, 0, event);
|
||||
if (!NILP (shadow))
|
||||
{
|
||||
tem = shadow_lookup (shadow, kludge, Qt, 0);
|
||||
if (!NILP (tem))
|
||||
{
|
||||
/* If both bindings are keymaps, this key is a prefix key,
|
||||
so don't say it is shadowed. */
|
||||
if (KEYMAPP (definition) && KEYMAPP (tem))
|
||||
;
|
||||
/* Avoid generating duplicate entries if the
|
||||
shadowed binding has the same definition. */
|
||||
else if (mention_shadow && !EQ (tem, definition))
|
||||
this_shadowed = 1;
|
||||
else
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
tem = Flookup_key (map, kludge, Qt);
|
||||
if (!EQ (tem, definition)) continue;
|
||||
|
||||
vect[slots_used].event = event;
|
||||
vect[slots_used].definition = definition;
|
||||
vect[slots_used].shadowed = this_shadowed;
|
||||
slots_used++;
|
||||
}
|
||||
else if (EQ (XCAR (tail), Qkeymap))
|
||||
{
|
||||
/* The same keymap might be in the structure twice, if we're
|
||||
using an inherited keymap. So skip anything we've already
|
||||
encountered. */
|
||||
tem = Fassq (tail, *seen);
|
||||
if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
|
||||
break;
|
||||
*seen = Fcons (Fcons (tail, prefix), *seen);
|
||||
}
|
||||
}
|
||||
|
||||
/* If we found some sparse map events, sort them. */
|
||||
|
||||
qsort (vect, slots_used, sizeof (struct describe_map_elt),
|
||||
describe_map_compare);
|
||||
|
||||
/* Now output them in sorted order. */
|
||||
|
||||
for (i = 0; i < slots_used; i++)
|
||||
{
|
||||
Lisp_Object start, end;
|
||||
|
||||
if (first)
|
||||
{
|
||||
previous_description_column = 0;
|
||||
insert ("\n", 1);
|
||||
first = 0;
|
||||
}
|
||||
|
||||
ASET (kludge, 0, vect[i].event);
|
||||
start = vect[i].event;
|
||||
end = start;
|
||||
|
||||
definition = vect[i].definition;
|
||||
|
||||
/* Find consecutive chars that are identically defined. */
|
||||
if (FIXNUMP (vect[i].event))
|
||||
{
|
||||
while (i + 1 < slots_used
|
||||
&& EQ (vect[i+1].event, make_fixnum (XFIXNUM (vect[i].event) + 1))
|
||||
&& !NILP (Fequal (vect[i + 1].definition, definition))
|
||||
&& vect[i].shadowed == vect[i + 1].shadowed)
|
||||
i++;
|
||||
end = vect[i].event;
|
||||
}
|
||||
|
||||
/* Now START .. END is the range to describe next. */
|
||||
|
||||
/* Insert the string to describe the event START. */
|
||||
insert1 (Fkey_description (kludge, prefix));
|
||||
|
||||
if (!EQ (start, end))
|
||||
{
|
||||
insert (" .. ", 4);
|
||||
|
||||
ASET (kludge, 0, end);
|
||||
/* Insert the string to describe the character END. */
|
||||
insert1 (Fkey_description (kludge, prefix));
|
||||
}
|
||||
|
||||
/* Print a description of the definition of this character.
|
||||
elt_describer will take care of spacing out far enough
|
||||
for alignment purposes. */
|
||||
(*elt_describer) (vect[i].definition, Qnil);
|
||||
|
||||
if (vect[i].shadowed)
|
||||
{
|
||||
ptrdiff_t pt = max (PT - 1, BEG);
|
||||
|
||||
SET_PT (pt);
|
||||
insert_string ("\n (this binding is currently shadowed)");
|
||||
pt = min (PT + 1, Z);
|
||||
SET_PT (pt);
|
||||
}
|
||||
}
|
||||
|
||||
SAFE_FREE ();
|
||||
}
|
||||
|
||||
static void
|
||||
describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
|
||||
{
|
||||
|
|
@ -3294,6 +2949,12 @@ describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
|
|||
Fterpri (Qnil, Qnil);
|
||||
}
|
||||
|
||||
static void
|
||||
describe_vector_basic (Lisp_Object elt, Lisp_Object fun)
|
||||
{
|
||||
call1 (fun, elt);
|
||||
}
|
||||
|
||||
DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
|
||||
doc: /* Insert a description of contents of VECTOR.
|
||||
This is text showing the elements of vector matched against indices.
|
||||
|
|
@ -3311,8 +2972,40 @@ DESCRIBER is the output function used; nil means use `princ'. */)
|
|||
return unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
DEFUN ("help--describe-vector", Fhelp__describe_vector, Shelp__describe_vector, 7, 7, 0,
|
||||
doc: /* Insert in the current buffer a description of the contents of VECTOR.
|
||||
Call DESCRIBER to insert the description of one value found in VECTOR.
|
||||
|
||||
PREFIX is a string describing the key which leads to the keymap that
|
||||
this vector is in.
|
||||
|
||||
If PARTIAL, it means do not mention suppressed commands.
|
||||
|
||||
SHADOW is a list of keymaps that shadow this map.
|
||||
If it is non-nil, look up the key in those maps and don't mention it
|
||||
if it is defined by any of them.
|
||||
|
||||
ENTIRE-MAP is the keymap in which this vector appears.
|
||||
If the definition in effect in the whole map does not match
|
||||
the one in this keymap, we ignore this one. */)
|
||||
(Lisp_Object vector, Lisp_Object prefix, Lisp_Object describer,
|
||||
Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map,
|
||||
Lisp_Object mention_shadow)
|
||||
{
|
||||
ptrdiff_t count = SPECPDL_INDEX ();
|
||||
specbind (Qstandard_output, Fcurrent_buffer ());
|
||||
CHECK_VECTOR_OR_CHAR_TABLE (vector);
|
||||
|
||||
bool b_partial = NILP (partial) ? false : true;
|
||||
bool b_mention_shadow = NILP (mention_shadow) ? false : true;
|
||||
|
||||
describe_vector (vector, prefix, describer, describe_vector_basic, b_partial,
|
||||
shadow, entire_map, true, b_mention_shadow);
|
||||
return unbind_to (count, Qnil);
|
||||
}
|
||||
|
||||
/* Insert in the current buffer a description of the contents of VECTOR.
|
||||
We call ELT_DESCRIBER to insert the description of one value found
|
||||
Call ELT_DESCRIBER to insert the description of one value found
|
||||
in VECTOR.
|
||||
|
||||
ELT_PREFIX describes what "comes before" the keys or indices defined
|
||||
|
|
@ -3568,6 +3261,7 @@ void
|
|||
syms_of_keymap (void)
|
||||
{
|
||||
DEFSYM (Qkeymap, "keymap");
|
||||
DEFSYM (Qdescribe_map_tree, "describe-map-tree");
|
||||
staticpro (&apropos_predicate);
|
||||
staticpro (&apropos_accumulate);
|
||||
apropos_predicate = Qnil;
|
||||
|
|
@ -3708,6 +3402,8 @@ be preferred. */);
|
|||
defsubr (&Scurrent_active_maps);
|
||||
defsubr (&Saccessible_keymaps);
|
||||
defsubr (&Skey_description);
|
||||
defsubr (&Skeymap__get_keyelt);
|
||||
defsubr (&Shelp__describe_vector);
|
||||
defsubr (&Sdescribe_vector);
|
||||
defsubr (&Ssingle_key_description);
|
||||
defsubr (&Stext_char_description);
|
||||
|
|
|
|||
|
|
@ -36,8 +36,6 @@ extern Lisp_Object current_global_map;
|
|||
extern char *push_key_description (EMACS_INT, char *);
|
||||
extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, bool, bool, bool);
|
||||
extern Lisp_Object get_keymap (Lisp_Object, bool, bool);
|
||||
extern void describe_map_tree (Lisp_Object, bool, Lisp_Object, Lisp_Object,
|
||||
const char *, bool, bool, bool, bool);
|
||||
extern ptrdiff_t current_minor_maps (Lisp_Object **, Lisp_Object **);
|
||||
extern void initial_define_key (Lisp_Object, int, const char *);
|
||||
extern void initial_define_lispy_key (Lisp_Object, const char *, const char *);
|
||||
|
|
|
|||
|
|
@ -941,7 +941,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
|
|||
else
|
||||
{
|
||||
Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
|
||||
errmsg = Fsubstitute_command_keys (Fget (errname, Qerror_message));
|
||||
errmsg = call1 (Qsubstitute_command_keys, Fget (errname, Qerror_message));
|
||||
file_error = Fmemq (Qfile_error, error_conditions);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1421,7 +1421,7 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
|
|||
{
|
||||
AUTO_STRING (prefixdoc,
|
||||
",\n\t is a prefix character for `backward-prefix-chars'");
|
||||
insert1 (Fsubstitute_command_keys (prefixdoc));
|
||||
insert1 (call1 (Qsubstitute_command_keys, prefixdoc));
|
||||
}
|
||||
|
||||
return syntax;
|
||||
|
|
|
|||
|
|
@ -3,6 +3,8 @@
|
|||
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Juanma Barranquero <lekktu@gmail.com>
|
||||
;; Eli Zaretskii <eliz@gnu.org>
|
||||
;; Stefan Kangas <stefankangas@gmail.com>
|
||||
;; Keywords: help, internal
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
|
@ -23,6 +25,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(ert-deftest help-split-fundoc-SECTION ()
|
||||
"Test new optional arg SECTION."
|
||||
|
|
@ -51,6 +54,313 @@
|
|||
(should (equal (help-split-fundoc nil t 'usage) nil))
|
||||
(should (equal (help-split-fundoc nil t 'doc) nil))))
|
||||
|
||||
|
||||
;;; substitute-command-keys
|
||||
|
||||
(defmacro with-substitute-command-keys-test (&rest body)
|
||||
`(cl-flet* ((test
|
||||
(lambda (orig result)
|
||||
(should (equal-including-properties
|
||||
(substitute-command-keys orig)
|
||||
result))))
|
||||
(test-re
|
||||
(lambda (orig regexp)
|
||||
(should (string-match (concat "^" regexp "$")
|
||||
(substitute-command-keys orig))))))
|
||||
,@body))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo" "foo")
|
||||
(test "\\invalid-escape" "\\invalid-escape")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/commands ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo \\[goto-char]" "foo M-g c")
|
||||
(test "\\[next-line]" "C-n")
|
||||
(test "\\[next-line]\n\\[next-line]" "C-n\nC-n")
|
||||
(test "\\[next-line]\\[previous-line]" "C-nC-p")
|
||||
(test "\\[next-line]\\=\\[previous-line]" "C-n\\[previous-line]")
|
||||
;; Allow any style of quotes, since the terminal might not support
|
||||
;; UTF-8. Same thing is done below.
|
||||
(test-re "\\[next-line]`foo'" "C-n[`'‘]foo['’]")
|
||||
(test "\\[emacs-version]" "M-x emacs-version")
|
||||
(test "\\[emacs-version]\\[next-line]" "M-x emacs-versionC-n")
|
||||
(test-re "\\[emacs-version]`foo'" "M-x emacs-version[`'‘]foo['’]")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/keymaps ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\{minibuffer-local-must-match-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
C-g abort-recursive-edit
|
||||
TAB minibuffer-complete
|
||||
C-j minibuffer-complete-and-exit
|
||||
RET minibuffer-complete-and-exit
|
||||
ESC Prefix Command
|
||||
SPC minibuffer-complete-word
|
||||
? minibuffer-completion-help
|
||||
<C-tab> file-cache-minibuffer-complete
|
||||
<XF86Back> previous-history-element
|
||||
<XF86Forward> next-history-element
|
||||
<down> next-line-or-history-element
|
||||
<next> next-history-element
|
||||
<prior> switch-to-completions
|
||||
<up> previous-line-or-history-element
|
||||
|
||||
M-v switch-to-completions
|
||||
|
||||
M-< minibuffer-beginning-of-buffer
|
||||
M-n next-history-element
|
||||
M-p previous-history-element
|
||||
M-r previous-matching-history-element
|
||||
M-s next-matching-history-element
|
||||
|
||||
")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
|
||||
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/undefined-map ()
|
||||
(with-substitute-command-keys-test
|
||||
(test-re "\\{foobar-map}"
|
||||
"\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/quotes ()
|
||||
(with-substitute-command-keys-test
|
||||
(let ((text-quoting-style 'curve))
|
||||
(test "quotes ‘like this’" "quotes ‘like this’")
|
||||
(test "`x'" "‘x’")
|
||||
(test "`" "‘")
|
||||
(test "'" "’")
|
||||
(test "\\`" "\\‘"))
|
||||
(let ((text-quoting-style 'straight))
|
||||
(test "quotes `like this'" "quotes 'like this'")
|
||||
(test "`x'" "'x'")
|
||||
(test "`" "'")
|
||||
(test "'" "'")
|
||||
(test "\\`" "\\'"))
|
||||
(let ((text-quoting-style 'grave))
|
||||
(test "quotes `like this'" "quotes `like this'")
|
||||
(test "`x'" "`x'")
|
||||
(test "`" "`")
|
||||
(test "'" "'")
|
||||
(test "\\`" "\\`"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/literals ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "foo \\=\\[goto-char]" "foo \\[goto-char]")
|
||||
(test "foo \\=\\=" "foo \\=")
|
||||
(test "\\=\\=" "\\=")
|
||||
(test "\\=\\[" "\\[")
|
||||
(let ((text-quoting-style 'curve))
|
||||
(test "\\=`x\\='" "`x'"))
|
||||
(let ((text-quoting-style 'straight))
|
||||
(test "\\=`x\\='" "`x'"))
|
||||
(let ((text-quoting-style 'grave))
|
||||
(test "\\=`x\\='" "`x'"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||||
(with-substitute-command-keys-test
|
||||
(test "\\[foobar" "\\[foobar")
|
||||
(test "\\=" "\\=")))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/multibyte ()
|
||||
;; Cannot use string= here, as that compares unibyte and multibyte
|
||||
;; strings not equal.
|
||||
(should (compare-strings
|
||||
(substitute-command-keys "\200 \\[goto-char]") nil nil
|
||||
"\200 M-g c" nil nil)))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/apropos ()
|
||||
(save-window-excursion
|
||||
(apropos "foo")
|
||||
(switch-to-buffer "*Apropos*")
|
||||
(goto-char (point-min))
|
||||
(should (looking-at "Type RET on"))))
|
||||
|
||||
(defvar help-tests-major-mode-map
|
||||
(let ((map (make-keymap)))
|
||||
(define-key map "x" 'foo-original)
|
||||
(define-key map "1" 'foo-range)
|
||||
(define-key map "2" 'foo-range)
|
||||
(define-key map "3" 'foo-range)
|
||||
(define-key map "4" 'foo-range)
|
||||
(define-key map (kbd "C-e") 'foo-something)
|
||||
(define-key map '[F1] 'foo-function-key1)
|
||||
(define-key map "(" 'short-range)
|
||||
(define-key map ")" 'short-range)
|
||||
(define-key map "a" 'foo-other-range)
|
||||
(define-key map "b" 'foo-other-range)
|
||||
(define-key map "c" 'foo-other-range)
|
||||
map))
|
||||
|
||||
(define-derived-mode help-tests-major-mode nil
|
||||
"Major mode for testing shadowing.")
|
||||
|
||||
(defvar help-tests-minor-mode-map
|
||||
(let ((map (make-keymap)))
|
||||
(define-key map "x" 'foo-shadow)
|
||||
(define-key map (kbd "C-e") 'foo-shadow)
|
||||
map))
|
||||
|
||||
(define-minor-mode help-tests-minor-mode
|
||||
"Minor mode for testing shadowing.")
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/test-mode ()
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(help-tests-major-mode)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
( .. ) short-range
|
||||
1 .. 4 foo-range
|
||||
a .. c foo-other-range
|
||||
|
||||
C-e foo-something
|
||||
x foo-original
|
||||
<F1> foo-function-key1
|
||||
|
||||
"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/shadow ()
|
||||
(with-substitute-command-keys-test
|
||||
(with-temp-buffer
|
||||
(help-tests-major-mode)
|
||||
(help-tests-minor-mode)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
( .. ) short-range
|
||||
1 .. 4 foo-range
|
||||
a .. c foo-other-range
|
||||
|
||||
C-e foo-something
|
||||
(this binding is currently shadowed)
|
||||
x foo-original
|
||||
(this binding is currently shadowed)
|
||||
<F1> foo-function-key1
|
||||
|
||||
"))))
|
||||
|
||||
(ert-deftest help-tests-substitute-command-keys/command-remap ()
|
||||
(with-substitute-command-keys-test
|
||||
(let ((help-tests-major-mode-map (make-keymap))) ; Protect from changes.
|
||||
(with-temp-buffer
|
||||
(help-tests-major-mode)
|
||||
(define-key help-tests-major-mode-map [remap foo] 'bar)
|
||||
(test "\\{help-tests-major-mode-map}"
|
||||
"\
|
||||
key binding
|
||||
--- -------
|
||||
|
||||
<remap> Prefix Command
|
||||
|
||||
<remap> <foo> bar
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/no-menu-t ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(menu-bar keymap
|
||||
(foo menu-item "Foo" foo
|
||||
:enable mark-active
|
||||
:help "Help text"))))))
|
||||
(describe-map-tree map nil nil nil nil t nil nil nil)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-a foo
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/no-menu-nil ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(menu-bar keymap
|
||||
(foo menu-item "Foo" foo
|
||||
:enable mark-active
|
||||
:help "Help text"))))))
|
||||
(describe-map-tree map nil nil nil nil nil nil nil nil)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-a foo
|
||||
<menu-bar> Prefix Command
|
||||
|
||||
<menu-bar> <foo> foo
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/mention-shadow-t ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(2 . bar))))
|
||||
(shadow-maps '((keymap . ((1 . baz))))))
|
||||
(describe-map-tree map t shadow-maps nil nil t nil nil t)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-a foo
|
||||
(this binding is currently shadowed)
|
||||
C-b bar
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/mention-shadow-nil ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(2 . bar))))
|
||||
(shadow-maps '((keymap . ((1 . baz))))))
|
||||
(describe-map-tree map t shadow-maps nil nil t nil nil nil)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-b bar
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/partial-t ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(2 . undefined)))))
|
||||
(describe-map-tree map t nil nil nil nil nil nil nil)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-a foo
|
||||
|
||||
")))))
|
||||
|
||||
(ert-deftest help-tests-describe-map-tree/partial-nil ()
|
||||
(with-temp-buffer
|
||||
(let ((standard-output (current-buffer))
|
||||
(map '(keymap . ((1 . foo)
|
||||
(2 . undefined)))))
|
||||
(describe-map-tree map nil nil nil nil nil nil nil nil)
|
||||
(should (equal (buffer-string) "key binding
|
||||
--- -------
|
||||
|
||||
C-a foo
|
||||
C-b undefined
|
||||
|
||||
")))))
|
||||
|
||||
(provide 'help-tests)
|
||||
|
||||
;;; help-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -1,98 +0,0 @@
|
|||
;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest doc-test-substitute-command-keys ()
|
||||
;; Bindings.
|
||||
(should (string= (substitute-command-keys "foo \\[goto-char]") "foo M-g c"))
|
||||
;; Cannot use string= here, as that compares unibyte and multibyte
|
||||
;; strings not equal.
|
||||
(should (compare-strings
|
||||
(substitute-command-keys "\200 \\[goto-char]") nil nil
|
||||
"\200 M-g c" nil nil))
|
||||
;; Literals.
|
||||
(should (string= (substitute-command-keys "foo \\=\\[goto-char]")
|
||||
"foo \\[goto-char]"))
|
||||
(should (string= (substitute-command-keys "foo \\=\\=")
|
||||
"foo \\="))
|
||||
;; Keymaps.
|
||||
;; I don't see that this is testing anything useful.
|
||||
;; AFAICS all it does it fail whenever someone modifies the
|
||||
;; minibuffer map.
|
||||
;;; (should (string= (substitute-command-keys
|
||||
;;; "\\{minibuffer-local-must-match-map}")
|
||||
;;; "\
|
||||
;;; key binding
|
||||
;;; --- -------
|
||||
;;;
|
||||
;;; C-g abort-recursive-edit
|
||||
;;; TAB minibuffer-complete
|
||||
;;; C-j minibuffer-complete-and-exit
|
||||
;;; RET minibuffer-complete-and-exit
|
||||
;;; ESC Prefix Command
|
||||
;;; SPC minibuffer-complete-word
|
||||
;;; ? minibuffer-completion-help
|
||||
;;; <C-tab> file-cache-minibuffer-complete
|
||||
;;; <XF86Back> previous-history-element
|
||||
;;; <XF86Forward> next-history-element
|
||||
;;; <down> next-line-or-history-element
|
||||
;;; <next> next-history-element
|
||||
;;; <prior> switch-to-completions
|
||||
;;; <up> previous-line-or-history-element
|
||||
;;;
|
||||
;;; M-v switch-to-completions
|
||||
;;;
|
||||
;;; M-< minibuffer-beginning-of-buffer
|
||||
;;; M-n next-history-element
|
||||
;;; M-p previous-history-element
|
||||
;;; M-r previous-matching-history-element
|
||||
;;; M-s next-matching-history-element
|
||||
;;;
|
||||
;;; "))
|
||||
(should (string=
|
||||
(substitute-command-keys
|
||||
"\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]")
|
||||
"C-g"))
|
||||
;; Allow any style of quotes, since the terminal might not support
|
||||
;; UTF-8.
|
||||
(should (string-match
|
||||
"\nUses keymap [`‘']foobar-map['’], which is not currently defined.\n"
|
||||
(substitute-command-keys "\\{foobar-map}")))
|
||||
;; Quotes.
|
||||
(should (let ((text-quoting-style 'grave))
|
||||
(string= (substitute-command-keys "quotes `like this'")
|
||||
"quotes `like this'")))
|
||||
(should (let ((text-quoting-style 'grave))
|
||||
(string= (substitute-command-keys "quotes ‘like this’")
|
||||
"quotes ‘like this’")))
|
||||
(should (let ((text-quoting-style 'straight))
|
||||
(string= (substitute-command-keys "quotes `like this'")
|
||||
"quotes 'like this'")))
|
||||
;; Bugs.
|
||||
(should (string= (substitute-command-keys "\\[foobar") "\\[foobar"))
|
||||
(should (string= (substitute-command-keys "\\=") "\\="))
|
||||
)
|
||||
|
||||
(provide 'doc-tests)
|
||||
;;; doc-tests.el ends here
|
||||
Loading…
Add table
Reference in a new issue