Improve the optional translation of quotes

Fix several problems with the recently-added custom variable
help-quote-translation where the code would quote inconsistently
in help buffers.  Add support for quoting 'like this', which
is common in other GNU programs in ASCII environments.  Change
help-quote-translation to use more mnemonic values: values are now the
initial quoting char, e.g., (setq help-quote-translation ?`) gets the
traditional Emacs help-buffer quoting style `like this'.  Change the
default behavior of substitute-command-keys to match what's done in
set-locale-environment, i.e., quote ‘like this’ if displayable,
'like this' otherwise.
* doc/lispref/help.texi (Keys in Documentation): Document
new behavior of substitute-command-keys, and document
help-quote-translation.
* doc/lispref/tips.texi (Documentation Tips):
Mention the effect of help-quote-translation.
* etc/NEWS: Mention new behavior of substitute-command-keys,
and merge help-quote-translation news into it.
When talking about doc strings, mention new ways to type quotes.
* lisp/cedet/mode-local.el (overload-docstring-extension):
Revert my recent change to this function, which shouldn't be
needed as the result is a doc string.
* lisp/cedet/mode-local.el (mode-local-print-binding)
(mode-local-describe-bindings-2):
* lisp/cedet/srecode/srt-mode.el (srecode-macro-help):
* lisp/cus-theme.el (describe-theme-1):
* lisp/descr-text.el (describe-text-properties-1, describe-char):
* lisp/emacs-lisp/cl-generic.el (cl--generic-describe):
* lisp/emacs-lisp/eieio-opt.el (eieio-help-class)
(eieio-help-constructor):
* lisp/emacs-lisp/package.el (describe-package-1):
* lisp/faces.el (describe-face):
* lisp/help-fns.el (help-fns--key-bindings)
(help-fns--compiler-macro, help-fns--parent-mode)
(help-fns--obsolete, help-fns--interactive-only)
(describe-function-1, describe-variable):
* lisp/help.el (describe-mode):
Use substitute-command-keys to ensure a more-consistent quoting
style in help buffers.
* lisp/cus-start.el (standard):
Document new help-quote-translation behavior.
* lisp/emacs-lisp/lisp-mode.el (lisp-fdefs):
* lisp/help-mode.el (help-xref-symbol-regexp, help-xref-info-regexp)
(help-xref-url-regexp):
* lisp/international/mule-cmds.el (help-xref-mule-regexp-template):
* lisp/wid-edit.el (widget-documentation-link-regexp):
Also match 'foo', in case we're in a help buffer generated when
help-quote-translation is ?'.
* src/doc.c: Include disptab.h, for DISP_CHAR_VECTOR.
(LEFT_SINGLE_QUOTATION_MARK, uLSQM0, uLSQM1, uLSQM2, uRSQM0)
(uRSQM1, uRSQM2, LSQM, RSQM): New constants.
(Fsubstitute_command_keys): Document and implement new behavior.
(Vhelp_quote_translation): Document new behavior.
This commit is contained in:
Paul Eggert 2015-06-19 00:35:43 -07:00
parent aad7ea32c5
commit c4151ebe15
19 changed files with 213 additions and 122 deletions

View file

@ -319,10 +319,22 @@ specifies @var{mapvar}'s value as the keymap for any following
@samp{\[@var{command}]} sequences in this documentation string.
@item `
(grave accent) stands for a left single quotation mark (@samp{}).
(grave accent) stands for a left quote, and alters the interpretation
of the next unmatched apostrophe.
@item '
(apostrophe) stands for a right single quotation mark (@samp{}) if
(apostrophe) stands for a right quote if preceded by grave accent and
there are no intervening apostrophes. Otherwise, apostrophe stands
for itself.
@item
(left single quotation mark) stands for a left quote.
@item
(right single quotation mark) stands for a right quote.
@item '
(apostrophe) stands for a right quote if
preceded by grave accent and there are no intervening apostrophes.
Otherwise, apostrophe stands for itself.
@ -335,6 +347,19 @@ and @samp{\=\=} puts @samp{\=} into the output.
@strong{Please note:} Each @samp{\} must be doubled when written in a
string in Emacs Lisp.
@defvar help-quote-translation
@cindex curved quotes
The value of this variable specifies the style
@code{substitute-command-keys} uses when generating left and right
quotes. If the variable's value is @code{?} (U+2018 LEFT SINGLE
QUOTATION MARK), the style is @t{like this} with curved single
quotes. If the value is @code{?'} (apostrophe), the style is @t{'like
this'} with apostrophes. If the value is @code{?`} (grave accent),
the style is @t{`like this'} with grave accent and apostrophe. The
default value @code{nil} means to use curved single quotes if
displayable and apostrophes otherwise.
@end defvar
@defun substitute-command-keys string
This function scans @var{string} for the above special sequences and
replaces them by what they stand for, returning the result as a string.

View file

@ -671,9 +671,11 @@ Documentation strings can also use an older single-quoting convention,
which quotes symbols with grave accent @t{`} and apostrophe
@t{'}: @t{`like-this'} rather than @t{like-this}. This
older convention was designed for now-obsolete displays in which grave
accent and apostrophe were mirror images. Documentation in this older
convention is converted to the standard convention when it is copied
into a help buffer. @xref{Keys in Documentation}.
accent and apostrophe were mirror images.
Documentation using either convention is converted to the user's
preferred format when it is copied into a help buffer. @xref{Keys in
Documentation}.
@cindex hyperlinks in documentation strings
Help mode automatically creates a hyperlink when a documentation string

View file

@ -845,11 +845,16 @@ when signaling a file error. For example, it now reports "Permission
denied" instead of "permission denied". The old behavior was problematic
in languages like German where downcasing rules depend on grammar.
** (substitute-command-keys "`foo'") now returns "foo".
That is, it replaces grave accents by left single quotation marks, and
apostrophes that match grave accents by right single quotation marks.
As before, isolated apostrophes and characters preceded by \= are
output as-is.
** substitute-command-keys now replaces quotes.
That is, it replaces left single quotation marks () by left quotes
and right single quotation marks () by right quotes. It also
replaces grave accents by left quotes, and apostrophes that match
grave accents by right quotes. As before, isolated apostrophes and
characters preceded by \= are output as-is. Left and right quotes are
determined by new custom variable help-quote-translation. ? means
quote like this, ?' means quote 'like this', ?` means quote `like
this', and nil (default) means quote like this if displayable and
'like this' otherwise.
+++
** The character classes [:alpha:] and [:alnum:] in regular expressions
@ -956,10 +961,10 @@ directory at point.
** Documentation strings now support quoting with curved single quotes
like-this in addition to the old style with grave accent and
apostrophe `like-this'. The new style looks better on today's displays.
When an old-style string is copied to a help buffer it is converted to
the new style.
** New option `help-quote-translation'.
In the new Electric Quote mode, you can enter curved single quotes
into documentation by typing ` and '. Outside Electric Quote mode,
you can enter them by typing C-x 8 [ and C-x 8 ], or (if your Alt
key works) by typing A-[ and A-].
+++
** Time-related changes:

View file

@ -598,16 +598,15 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'."
(defun overload-docstring-extension (overload)
"Return the doc string that augments the description of OVERLOAD."
(let ((doc "\n\This function can be overloaded\
with define-mode-local-override.")
with `define-mode-local-override'.")
(sym (overload-obsoleted-by overload)))
(when sym
(setq doc (format "%s\nIt has made the overload %s obsolete since %s."
(setq doc (format "%s\nIt has made the overload `%s' obsolete since %s."
doc sym (get sym 'overload-obsoleted-since))))
(setq sym (overload-that-obsolete overload))
(when sym
(setq doc (format
"%s\nThis overload is obsolete since %s;\nuse %s instead."
doc (get overload 'overload-obsoleted-since) sym)))
(setq doc (format "%s\nThis overload is obsolete since %s;\nUse `%s' instead."
doc (get overload 'overload-obsoleted-since) sym)))
doc))
(defun mode-local-augment-function-help (symbol)
@ -630,9 +629,10 @@ SYMBOL is a function that can be overridden."
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."
(let ((value (symbol-value symbol)))
(princ (format "\n %s value is\n " symbol))
(princ (format (substitute-command-keys "\n %s value is\n ")
symbol))
(if (and value (symbolp value))
(princ (format "%s" value))
(princ (format (substitute-command-keys "%s") value))
(let ((pt (point)))
(pp value)
(save-excursion
@ -690,7 +690,7 @@ SYMBOL is a function that can be overridden."
)
((symbolp buffer-or-mode)
(setq mode buffer-or-mode)
(princ (format "%s\n" buffer-or-mode))
(princ (format (substitute-command-keys "%s\n") buffer-or-mode))
)
((signal 'wrong-type-argument
(list 'buffer-or-mode buffer-or-mode))))
@ -700,7 +700,7 @@ SYMBOL is a function that can be overridden."
(while mode
(setq table (get mode 'mode-local-symbol-table))
(when table
(princ (format "\n- From %s\n" mode))
(princ (format (substitute-command-keys "\n- From %s\n") mode))
(mode-local-print-bindings table))
(setq mode (get-mode-local-parent mode)))))

View file

@ -258,9 +258,9 @@ we can tell font lock about them.")
(when (class-abstract-p C)
(throw 'skip nil))
(princ "")
(princ (substitute-command-keys ""))
(princ name)
(princ "")
(princ (substitute-command-keys ""))
(when (slot-exists-p C 'key)
(when key
(princ " - Character Key: ")

View file

@ -223,9 +223,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; doc.c
(help-quote-translation help
(choice
(const :tag "No translation" nil)
(const :tag "Translate curly single quotes to ASCII" traditional)
(const :tag "Translate ASCII single quotes to curly" prefer-unicode))
(character :tag "Quote like this" :value ?)
(character :tag "Quote 'like this'" :value ?\')
(character :tag "Quote `like this'" :value ?\`)
(const :tag "Quote like this if displyable, 'like this' otherwise" nil))
"25.1")
;; dosfns.c
(dos-display-scancodes display boolean)

View file

@ -492,10 +492,10 @@ It includes all faces in list FACES."
'("" "c")))
doc)
(when fn
(princ " in ")
(princ (substitute-command-keys " in "))
(help-insert-xref-button (file-name-nondirectory fn)
'help-theme-def fn)
(princ ""))
(princ (substitute-command-keys "")))
(princ ".\n")
(if (custom-theme-p theme)
(progn

View file

@ -161,8 +161,11 @@ otherwise."
;; Buttons
(when (and button (not (widgetp wid-button)))
(newline)
(insert "Here is a " (format "%S" button-type)
" button labeled " button-label ".\n\n"))
(insert (substitute-command-keys "Here is a ")
(format "%S" button-type)
(substitute-command-keys " button labeled ")
button-label
(substitute-command-keys ".\n\n")))
;; Overlays
(when overlays
(newline)
@ -738,8 +741,9 @@ relevant to POS."
(when face
(insert (propertize " " 'display '(space :align-to 5))
"face: ")
(insert (concat "" (symbol-name face) ""))
(insert "\n")))))
(insert (substitute-command-keys "")
(symbol-name face)
(substitute-command-keys "\n"))))))
(insert "these terminal codes:\n")
(dotimes (i (length disp-vector))
(insert (car (aref disp-vector i))

View file

@ -876,11 +876,11 @@ Can only be used from within the lexical body of a primary or around method."
(cl--generic-method-specializers method)))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(insert " in ")
(insert (substitute-command-keys " in "))
(help-insert-xref-button (help-fns-short-filename file)
'help-function-def met-name file
'cl-defmethod)
(insert ".\n")))
(insert (substitute-command-keys ".\n"))))
(insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
;;; Support for (head <val>) specializers.

View file

@ -90,11 +90,11 @@ If CLASS is actually an object, then also display current values of that object.
" class")
(let ((location (find-lisp-object-file-name class 'eieio-defclass)))
(when location
(insert " in ")
(insert (substitute-command-keys " in "))
(help-insert-xref-button
(help-fns-short-filename location)
'eieio-class-def class location 'eieio-defclass)
(insert "")))
(insert (substitute-command-keys ""))))
(insert ".\n")
;; Parents
(let ((pl (eieio-class-parents class))
@ -103,10 +103,10 @@ If CLASS is actually an object, then also display current values of that object.
(insert " Inherits from ")
(while (setq cur (pop pl))
(setq cur (eieio--class-name cur))
(insert "")
(insert (substitute-command-keys ""))
(help-insert-xref-button (symbol-name cur)
'help-function cur)
(insert (if pl ", " "")))
(insert (substitute-command-keys (if pl ", " ""))))
(insert ".\n")))
;; Children
(let ((ch (eieio-class-children class))
@ -114,10 +114,10 @@ If CLASS is actually an object, then also display current values of that object.
(when ch
(insert " Children ")
(while (setq cur (pop ch))
(insert "")
(insert (substitute-command-keys ""))
(help-insert-xref-button (symbol-name cur)
'help-function cur)
(insert (if ch ", " "")))
(insert (substitute-command-keys (if ch ", " ""))))
(insert ".\n")))
;; System documentation
(let ((doc (documentation-property class 'variable-documentation)))
@ -130,9 +130,9 @@ If CLASS is actually an object, then also display current values of that object.
(when generics
(insert (propertize "Specialized Methods:\n\n" 'face 'bold))
(dolist (generic generics)
(insert "")
(insert (substitute-command-keys ""))
(help-insert-xref-button (symbol-name generic) 'help-function generic)
(insert "")
(insert (substitute-command-keys ""))
(pcase-dolist (`(,qualifiers ,args ,doc)
(eieio-method-documentation generic class))
(insert (format " %s%S\n" qualifiers args)
@ -245,11 +245,11 @@ are not abstract."
(setq location
(find-lisp-object-file-name ctr def)))
(when location
(insert " in ")
(insert (substitute-command-keys " in "))
(help-insert-xref-button
(help-fns-short-filename location)
'eieio-class-def ctr location 'eieio-defclass)
(insert ""))
(insert (substitute-command-keys "")))
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
(goto-char (point-max))
(if (autoloadp def)

View file

@ -403,8 +403,8 @@
;; Words inside \\[] tend to be for `substitute-command-keys'.
("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
(1 font-lock-constant-face prepend))
;; Words inside and `' tend to be symbol names.
("[`]\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)[']"
;; Words inside and '' and `' tend to be symbol names.
("['`]\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)[']"
(1 font-lock-constant-face prepend))
;; Constant values.
("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
@ -452,8 +452,8 @@
;; Erroneous structures.
(,(concat "(" cl-errs-re "\\_>")
(1 font-lock-warning-face))
;; Words inside and `' tend to be symbol names.
("[`]\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)[']"
;; Words inside and '' and `' tend to be symbol names.
("['`]\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)[']"
(1 font-lock-constant-face prepend))
;; Constant values.
("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)

View file

@ -2173,17 +2173,18 @@ will be deleted."
"Installed"
(capitalize status)) ;FIXME: Why comment-face?
'font-lock-face 'font-lock-comment-face))
(insert " in ")
(insert (substitute-command-keys " in "))
;; Todo: Add button for uninstalling.
(help-insert-xref-button (abbreviate-file-name
(file-name-as-directory pkg-dir))
'help-package-def pkg-dir)
(if (and (package-built-in-p name)
(not (package-built-in-p name version)))
(insert ",\n shadowing a "
(insert (substitute-command-keys
",\n shadowing a ")
(propertize "built-in package"
'font-lock-face 'font-lock-builtin-face))
(insert ""))
(insert (substitute-command-keys "")))
(if signed
(insert ".")
(insert " (unsigned)."))

View file

@ -1428,10 +1428,12 @@ If FRAME is omitted or nil, use the selected frame."
(when alias
(setq face alias)
(insert
(format "\n %s is an alias for the face %s.\n%s"
(format (substitute-command-keys
"\n %s is an alias for the face %s.\n%s")
f alias
(if (setq obsolete (get f 'obsolete-face))
(format " This face is obsolete%s; use %s instead.\n"
(format (substitute-command-keys
" This face is obsolete%s; use %s instead.\n")
(if (stringp obsolete)
(format " since %s" obsolete)
"")
@ -1449,12 +1451,13 @@ If FRAME is omitted or nil, use the selected frame."
(help-xref-button 1 'help-customize-face f)))
(setq file-name (find-lisp-object-file-name f 'defface))
(when file-name
(princ "Defined in ")
(princ (substitute-command-keys "Defined in "))
(princ (file-name-nondirectory file-name))
(princ "")
(princ (substitute-command-keys ""))
;; Make a hyperlink to the library.
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward
(substitute-command-keys "\\([^]+\\)") nil t)
(help-xref-button 1 'help-face-def f file-name))
(princ ".")
(terpri)

View file

@ -306,7 +306,9 @@ suitable file is found, return nil."
(when remapped
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
(concat "" (symbol-name remapped) "")
(concat (substitute-command-keys "")
(symbol-name remapped)
(substitute-command-keys ""))
"an anonymous command"))
(princ ".\n"))
@ -340,16 +342,18 @@ suitable file is found, return nil."
(insert "\nThis function has a compiler macro")
(if (symbolp handler)
(progn
(insert (format " %s" handler))
(insert (format (substitute-command-keys " %s") handler))
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
(help-xref-button 1 'help-function handler)))
;; FIXME: Obsolete since 24.4.
(let ((lib (get function 'compiler-macro-file)))
(when (stringp lib)
(insert (format " in %s" lib))
(insert (format (substitute-command-keys " in %s") lib))
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
(help-xref-button 1 'help-function-cmacro function lib)))))
(insert ".\n"))))
@ -404,13 +408,13 @@ suitable file is found, return nil."
(get function
'derived-mode-parent))))
(when parent-mode
(insert "\nParent mode: ")
(insert (substitute-command-keys "\nParent mode: "))
(let ((beg (point)))
(insert (format "%s" parent-mode))
(make-text-button beg (point)
'type 'help-function
'help-args (list parent-mode)))
(insert ".\n"))))
(insert (substitute-command-keys ".\n")))))
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
@ -426,7 +430,9 @@ suitable file is found, return nil."
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
(use (format ";\nuse %s instead." use))
(use (format (substitute-command-keys
";\nuse %s instead.")
use))
(t "."))
"\n"))))
@ -462,7 +468,8 @@ FILE is the file where FUNCTION was probably defined."
(format ";\nin Lisp code %s" interactive-only))
((and (symbolp 'interactive-only)
(not (eq interactive-only t)))
(format ";\nin Lisp code use %s instead."
(format (substitute-command-keys
";\nin Lisp code use %s instead.")
interactive-only))
(t "."))
"\n")))))
@ -531,7 +538,8 @@ FILE is the file where FUNCTION was probably defined."
;; Aliases are Lisp functions, so we need to check
;; aliases before functions.
(aliased
(format "an alias for %s" real-def))
(format (substitute-command-keys "an alias for %s")
real-def))
((autoloadp def)
(format "%s autoloaded %s"
(if (commandp def) "an interactive" "an")
@ -565,21 +573,24 @@ FILE is the file where FUNCTION was probably defined."
(with-current-buffer standard-output
(save-excursion
(save-match-data
(when (re-search-backward "alias for \\([^]+\\)" nil t)
(when (re-search-backward (substitute-command-keys
"alias for \\([^]+\\)")
nil t)
(help-xref-button 1 'help-function real-def)))))
(when file-name
(princ " in ")
(princ (substitute-command-keys " in "))
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
(princ (if (eq file-name 'C-source)
"C source code"
(help-fns-short-filename file-name)))
(princ "")
(princ (substitute-command-keys ""))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
(help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(with-current-buffer (help-buffer)
@ -712,14 +723,17 @@ it is displayed along with the global value."
(if file-name
(progn
(princ " is a variable defined in ")
(princ (substitute-command-keys
" is a variable defined in "))
(princ (if (eq file-name 'C-source)
"C source code"
(file-name-nondirectory file-name)))
(princ ".\n")
(princ (substitute-command-keys ".\n"))
(with-current-buffer standard-output
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward (substitute-command-keys
"\\([^]+\\)")
nil t)
(help-xref-button 1 'help-variable-def
variable file-name)))
(if valvoid
@ -849,7 +863,8 @@ if it is given a local binding.\n")))
;; Mention if it's an alias.
(unless (eq alias variable)
(setq extra-line t)
(princ (format " This variable is an alias for %s.\n"
(princ (format (substitute-command-keys
" This variable is an alias for %s.\n")
alias)))
(when obsolete
@ -858,7 +873,8 @@ if it is given a local binding.\n")))
(if (nth 2 obsolete)
(princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
(use (format ";\n use %s instead."
(use (format (substitute-command-keys
";\n use %s instead.")
(car obsolete)))
(t ".")))
(terpri))
@ -889,14 +905,15 @@ if it is given a local binding.\n")))
;; Otherwise, assume it was set directly.
(setq file (car file)
dir-file nil)))
(princ (if dir-file
"by the file\n "
"for the directory\n "))
(princ (substitute-command-keys
(if dir-file
"by the file\n "
"for the directory\n ")))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
'help-args (list variable file)))
(princ ".\n")))
(princ (substitute-command-keys ".\n"))))
(princ " This variable's value is file-local.\n")))
(when (memq variable ignored-local-variables)
@ -910,8 +927,9 @@ variable.\n"))
(princ " This variable may be risky if used as a \
file-local variable.\n")
(when (assq variable safe-local-variable-values)
(princ " However, you have added it to \
safe-local-variable-values.\n")))
(princ (substitute-command-keys
" However, you have added it to \
safe-local-variable-values.\n"))))
(when safe-var
(setq extra-line t)
@ -919,7 +937,8 @@ file-local variable.\n")
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
"which is a byte-compiled expression.\n"
(format "%s.\n" safe-var))))
(format (substitute-command-keys "%s.\n")
safe-var))))
(if extra-line (terpri))
(princ "Documentation:\n")

View file

@ -322,7 +322,7 @@ Commands:
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
;; Note starting with word-syntax character:
"[`]\\(\\sw\\(\\sw\\|\\s_\\)+\\)[']"))
"['`]\\(\\sw\\(\\sw\\|\\s_\\)+\\)[']"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to
@ -338,11 +338,11 @@ when help commands related to multilingual environment (e.g.,
(defconst help-xref-info-regexp
(purecopy
"\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+[`]\\([^']+\\)[']")
"\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`]\\([^']+\\)[']")
"Regexp matching doc string references to an Info node.")
(defconst help-xref-url-regexp
(purecopy "\\<[Uu][Rr][Ll][ \t\n]+[`]\\([^']+\\)[']")
(purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`]\\([^']+\\)[']")
"Regexp matching doc string references to a URL.")
;;;###autoload

View file

@ -964,12 +964,14 @@ documentation for the major and minor modes of that buffer."
(let* ((mode major-mode)
(file-name (find-lisp-object-file-name mode nil)))
(when file-name
(princ (concat " defined in " (file-name-nondirectory file-name)
""))
(princ (concat (substitute-command-keys " defined in ")
(file-name-nondirectory file-name)
(substitute-command-keys "")))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
(re-search-backward "\\([^]+\\)" nil t)
(re-search-backward (substitute-command-keys "\\([^]+\\)")
nil t)
(help-xref-button 1 'help-function-def mode file-name)))))
(princ ":\n")
(princ (documentation major-mode)))))

View file

@ -177,7 +177,7 @@
"\\(charset\\)"
"\\)\\s-+\\)?"
;; Note starting with word-syntax character:
"[`]\\(\\sw\\(\\sw\\|\\s_\\)+\\)[']")))
"['`]\\(\\sw\\(\\sw\\|\\s_\\)+\\)[']")))
(defun coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system which differs from CODING-SYSTEM in EOL conversion.

View file

@ -2863,7 +2863,7 @@ The following properties have special meanings for this widget:
:type 'boolean
:group 'widget-documentation)
(defcustom widget-documentation-link-regexp "[`]\\([^\n `']+\\)[']"
(defcustom widget-documentation-link-regexp "['`]\\([^\n `']+\\)[']"
"Regexp for matching potential links in documentation strings.
The first group should be the link itself."
:type 'regexp

View file

@ -32,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "character.h"
#include "buffer.h"
#include "disptab.h"
#include "keyboard.h"
#include "keymap.h"
@ -683,6 +684,18 @@ the same file name is found in the `doc-directory'. */)
return unbind_to (count, Qnil);
}
/* Declare named constants for U+2018 LEFT SINGLE QUOTATION MARK and
U+2019 RIGHT SINGLE QUOTATION MARK, which have UTF-8 encodings
"\xE2\x80\x98" and "\xE2\x80\x99", respectively. */
enum
{
LEFT_SINGLE_QUOTATION_MARK = 0x2018,
uLSQM0 = 0xE2, uLSQM1 = 0x80, uLSQM2 = 0x98,
uRSQM0 = 0xE2, uRSQM1 = 0x80, uRSQM2 = 0x99,
};
static unsigned char const LSQM[] = { uLSQM0, uLSQM1, uLSQM2 };
static unsigned char const RSQM[] = { uRSQM0, uRSQM1, uRSQM2 };
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
Ssubstitute_command_keys, 1, 1, 0,
doc: /* Substitute key descriptions for command names in STRING.
@ -699,8 +712,10 @@ summary).
Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
as the keymap for future \\=\\[COMMAND] substrings.
Each \\=` is replaced by . Each ' preceded by \\=` and without
intervening ' is replaced by .
Each \\= and \\= are replaced by left and right quote. Each \\=` is
replaced by left quote, and each ' preceded by \\=` and without
intervening ' is replaced by right quote. Left and right quote
characters are specified by help-quote-translation.
\\=\\= quotes the following character and is discarded; thus,
\\=\\=\\=\\= puts \\=\\= into the output, \\=\\=\\=\\[ puts \\=\\[ into the output, and
@ -719,7 +734,7 @@ Otherwise, return a new string. */)
ptrdiff_t bsize;
Lisp_Object tem;
Lisp_Object keymap;
unsigned char *start;
unsigned char const *start;
ptrdiff_t length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
@ -735,6 +750,21 @@ Otherwise, return a new string. */)
name = Qnil;
GCPRO4 (string, tem, keymap, name);
enum { unicode, grave_accent, apostrophe } quote_translation = unicode;
if (EQ (Vhelp_quote_translation, make_number ('`')))
quote_translation = grave_accent;
else if (EQ (Vhelp_quote_translation, make_number ('\'')))
quote_translation = apostrophe;
else if (NILP (Vhelp_quote_translation)
&& DISP_TABLE_P (Vstandard_display_table))
{
Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
LEFT_SINGLE_QUOTATION_MARK);
if (VECTORP (dv) && ASIZE (dv) == 1
&& EQ (AREF (dv, 0), make_number ('\'')))
quote_translation = apostrophe;
}
multibyte = STRING_MULTIBYTE (string);
nchars = 0;
@ -932,38 +962,39 @@ Otherwise, return a new string. */)
strp = SDATA (string) + idx;
}
}
else if (EQ (Vhelp_quote_translation, Qprefer_unicode)
&& (strp[0] == '`'))
else if (strp[0] == '`' && quote_translation == unicode)
{
in_quote = true;
start = (unsigned char *) "\xE2\x80\x98"; /* */
start = LSQM;
subst_quote:
length = 1;
length_byte = 3;
idx = strp - SDATA (string) + 1;
goto subst;
}
else if (EQ (Vhelp_quote_translation, Qprefer_unicode)
&& (strp[0] == '\'' && in_quote))
else if (strp[0] == '`' && quote_translation == apostrophe)
{
*bufp++ = '\'';
strp++;
nchars++;
changed = true;
}
else if (strp[0] == '\'' && in_quote)
{
in_quote = false;
start = (unsigned char *) "\xE2\x80\x99"; /* */
start = RSQM;
goto subst_quote;
}
else if (EQ (Vhelp_quote_translation, Qtraditional)
&& (strp[0] == 0xE2)
&& (strp[1] == 0x80)
&& ((strp[2] == 0x98) /* curly opening quote */
|| (strp[2] == 0x99))) /* curly closing quote */
else if (strp[0] == uLSQM0 && strp[1] == uLSQM1
&& (strp[2] == uLSQM2 || strp[2] == uRSQM2)
&& quote_translation != unicode)
{
start = (strp[2] == 0x98) ? "`" : "'";
length = 1;
length_byte = 1;
idx = strp - SDATA (string) + 3;
goto subst;
*bufp++ = (strp[2] == uLSQM2 && quote_translation == grave_accent
? '`' : '\'');
strp += 3;
nchars++;
changed = true;
}
else if (! multibyte) /* just copy other chars */
*bufp++ = *strp++, nchars++;
else
@ -1005,15 +1036,13 @@ syms_of_doc (void)
Vbuild_files = Qnil;
DEFVAR_LISP ("help-quote-translation", Vhelp_quote_translation,
doc: /* How to translate quotes for display in *Help*.
If the value is nil (default), no translation is done.
If it's the symbol `traditional', any occurrences of the curly quotes
are translated to their ASCII "equivalents", GRAVE and APOSTROPHE.
If it's the symbol `prefer-unicode', any matched pairs of GRAVE and
APOSTROPHE will get translated into the "equivalent" curly quotes.
Note that any translation done is done in a fresh copy of the doc
string, and doesn't overwrite the original characters. */);
doc: /* Style to use for single quotes in help.
The value is a left single quote character of some style.
Quote \\=like this\\= if the value is ?\\= (left single quotation mark).
Quote 'like this' if the value is ?' (apostrophe).
Quote \\=`like this' if the value is ?\\=` (grave accent).
The default value is nil, which means quote with left single quotation mark
if displayable, and with apostrophe otherwise. */);
Vhelp_quote_translation = Qnil;
defsubr (&Sdocumentation);