diff options
Diffstat (limited to 'lisp/man.el')
| -rw-r--r-- | lisp/man.el | 205 |
1 files changed, 151 insertions, 54 deletions
diff --git a/lisp/man.el b/lisp/man.el index 25dbd83600f..d96396483d3 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -97,6 +97,21 @@ :group 'external :group 'help) +(defcustom Man-prefer-synchronous-call nil + "Whether to call the Un*x \"man\" program synchronously. +When this is non-nil, call the \"man\" program synchronously +(rather than asynchronously, which is the default behavior)." + :type 'boolean + :group 'man + :version "30.1") + +(defcustom Man-support-remote-systems nil + "Whether to call the Un*x \"man\" program on remote systems. +When this is non-nil, call the \"man\" program on the remote +system determined by `default-directory'." + :type 'boolean + :version "30.1") + (defcustom Man-filter-list nil "Manpage cleaning filter command phrases. This variable contains a list of the following form: @@ -307,7 +322,7 @@ If this is nil, `man' will use `locale-coding-system'." :type 'hook :group 'man) -(defvar Man-name-regexp "[-[:alnum:]_+][-[:alnum:]_.:+]*" +(defvar Man-name-regexp "[-[:alnum:]_+[@][-[:alnum:]_.:+]*" "Regular expression describing the name of a manpage (without section).") (defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]" @@ -523,8 +538,9 @@ Otherwise, the value is whatever the function (define-button-type 'Man-xref-normal-file 'action (lambda (button) - (let ((f (substitute-in-file-name - (button-get button 'Man-target-string)))) + (let ((f (concat (file-remote-p default-directory) + (substitute-in-file-name + (button-get button 'Man-target-string))))) (if (file-exists-p f) (if (file-readable-p f) (view-file f) @@ -537,6 +553,65 @@ Otherwise, the value is whatever the function ;; ====================================================================== ;; utilities +(defun Man-default-directory () + "Return a default directory according to `Man-support-remote-systems'." + ;; Ensure that `default-directory' exists and is readable. + ;; We assume, that this function is always called inside the `man' + ;; command, so that we can check `current-prefix-arg' for reverting + ;; `Man-support-remote-systems'. + (let ((result default-directory) + (remote (if current-prefix-arg + (not Man-support-remote-systems) + Man-support-remote-systems))) + + ;; Use a local directory if remote isn't possible. + (when (and (file-remote-p default-directory) + (not (and remote + ;; TODO:: Test that remote processes are supported. + ))) + (setq result (expand-file-name "~/"))) + + ;; Check, whether the directory is accessible. + (if (file-accessible-directory-p result) + result + (expand-file-name (concat (file-remote-p result) "~/"))))) + +(defun Man-shell-file-name () + "Return a proper shell file name, respecting remote directories." + (or ; This works also in the local case. + (connection-local-value shell-file-name) + "/bin/sh")) + +(defun Man-header-file-path () + "Return the C header file search path that Man should use. +Normally, this is the value of the user option `Man-header-file-path', +but when the man page is formatted on a remote system (see +`Man-support-remote-systems'), this function tries to figure out the +list of directories where the remote system has the C header files." + (let ((remote-id (file-remote-p default-directory))) + (if (null remote-id) + ;; The local case. + Man-header-file-path + ;; The remote case. Use connection-local variables. + (mapcar + (lambda (elt) (concat remote-id elt)) + (with-connection-local-variables + (or (and (local-variable-p 'Man-header-file-path (current-buffer)) + Man-header-file-path) + (setq-connection-local + Man-header-file-path + (let ((arch (with-temp-buffer + (when (zerop (ignore-errors + (process-file "gcc" nil '(t nil) nil + "-print-multiarch"))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position))))) + (base '("/usr/include" "/usr/local/include"))) + (if (zerop (length arch)) + base + (append + base (list (expand-file-name arch "/usr/include")))))))))))) + (defun Man-init-defvars () "Used for initializing variables based on display's color support. This is necessary if one wants to dump man.el with Emacs." @@ -575,7 +650,9 @@ This is necessary if one wants to dump man.el with Emacs." (if Man-sed-script (concat "-e '" Man-sed-script "'") "") - "-e '/^[\001-\032][\001-\032]*$/d'" + ;; Use octal numbers. Otherwise, \032 (Ctrl-Z) would + ;; suspend remote connections. + "-e '/^[\\o001-\\o032][\\o001-\\o032]*$/d'" "-e '/\e[789]/s///g'" "-e '/Reformatting page. Wait/d'" "-e '/Reformatting entry. Wait/d'" @@ -684,7 +761,11 @@ and the `Man-section-translations-alist' variables)." (setq name (match-string 2 ref) section (match-string 1 ref)))) (if (string= name "") - ref ; Return the reference as is + ;; see Bug#66390 + (mapconcat 'identity + (mapcar #'shell-quote-argument + (split-string ref "\\s-+")) + " ") ; Return the reference as is (if Man-downcase-section-letters-flag (setq section (downcase section))) (while slist @@ -709,22 +790,23 @@ program has no such option, but interprets any name containing a \"/\" as a local filename. The function returns either `man-db' `man', or nil." (if (eq Man-support-local-filenames 'auto-detect) - (setq Man-support-local-filenames - (with-temp-buffer - (let ((default-directory - ;; Ensure that `default-directory' exists and is readable. - (if (file-accessible-directory-p default-directory) - default-directory - (expand-file-name "~/")))) - (ignore-errors - (call-process manual-program nil t nil "--help"))) - (cond ((search-backward "--local-file" nil 'move) - 'man-db) - ;; This feature seems to be present in at least ver 1.4f, - ;; which is about 20 years old. - ;; I don't know if this version has an official name? - ((looking-at "^man, versione? [1-9]") - 'man)))) + (with-connection-local-variables + (or (and (local-variable-p 'Man-support-local-filenames (current-buffer)) + Man-support-local-filenames) + (setq-connection-local + Man-support-local-filenames + (with-temp-buffer + (let ((default-directory (Man-default-directory))) + (ignore-errors + (process-file manual-program nil t nil "--help"))) + (cond ((search-backward "--local-file" nil 'move) + 'man-db) + ;; This feature seems to be present in at least + ;; ver 1.4f, which is about 20 years old. I + ;; don't know if this version has an official + ;; name? + ((looking-at "^man, versione? [1-9]") + 'man)))))) Man-support-local-filenames)) @@ -910,7 +992,8 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description" (unless (and Man-completion-cache (string-prefix-p (car Man-completion-cache) prefix)) (with-temp-buffer - (setq default-directory "/") ;; in case inherited doesn't exist + ;; In case inherited doesn't exist. + (setq default-directory (Man-default-directory)) ;; Actually for my `man' the arg is a regexp. ;; POSIX says it must be ERE and "man-db" seems to agree, ;; whereas under macOS it seems to be BRE-style and doesn't @@ -924,12 +1007,21 @@ foo(sec)[, bar(sec) [, ...]] [other stuff] - description" ;; error later. (when (eq 0 (ignore-errors - (call-process + (process-file manual-program nil '(t nil) nil "-k" (concat (when (or Man-man-k-use-anchor (string-equal prefix "")) "^") - prefix)))) + (if (string-equal prefix "") + prefix + ;; FIXME: shell-quote-argument + ;; is not entirely + ;; appropriate: we actually + ;; need to quote ERE here. + ;; But we don't have that, and + ;; shell-quote-argument does + ;; the job... + (shell-quote-argument prefix)))))) (setq table (Man-parse-man-k))))) ;; Cache the table for later reuse. (when table @@ -999,7 +1091,12 @@ names or descriptions. The pattern argument is usually an Note that in some cases you will need to use \\[quoted-insert] to quote the SPC character in the above examples, because this command attempts -to auto-complete your input based on the installed manual pages." +to auto-complete your input based on the installed manual pages. + +If `default-directory' is remote, and `Man-support-remote-systems' +is non-nil, this command formats the man page on the remote system. +A prefix argument reverses the value of `Man-support-remote-systems' +for the current invocation." (interactive (list (let* ((default-entry (Man-default-man-entry)) @@ -1065,12 +1162,7 @@ to auto-complete your input based on the installed manual pages." Man-coding-system locale-coding-system)) ;; Avoid possible error by using a directory that always exists. - (default-directory - (if (and (file-directory-p default-directory) - (not (find-file-name-handler default-directory - 'file-directory-p))) - default-directory - "/"))) + (default-directory (Man-default-directory))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") ;; In Debian Woody, at least, we get overlong lines under X @@ -1099,9 +1191,13 @@ to auto-complete your input based on the installed manual pages." (defun Man-getpage-in-background (topic) "Use TOPIC to build and fire off the manpage and cleaning command. Return the buffer in which the manpage will appear." - (let* ((man-args topic) - (bufname (concat "*Man " man-args "*")) - (buffer (get-buffer bufname))) + (let* ((default-directory (Man-default-directory)) + (man-args topic) + (bufname + (if (file-remote-p default-directory) + (format "*Man %s %s*" (file-remote-p default-directory) man-args) + (format "*Man %s*" man-args))) + (buffer (get-buffer bufname))) (if buffer (Man-notify-when-ready buffer) (message "Invoking %s %s in the background" manual-program man-args) @@ -1118,21 +1214,21 @@ Return the buffer in which the manpage will appear." "[cleaning...]") 'face 'mode-line-emphasis))) (Man-start-calling - (if (fboundp 'make-process) - (let ((proc (start-process + (if (and (fboundp 'make-process) + (not Man-prefer-synchronous-call)) + (let ((proc (start-file-process manual-program buffer - (if (memq system-type '(cygwin windows-nt)) - shell-file-name - "sh") + (Man-shell-file-name) shell-command-switch (format (Man-build-man-command) man-args)))) (set-process-sentinel proc 'Man-bgproc-sentinel) (set-process-filter proc 'Man-bgproc-filter)) (let* ((inhibit-read-only t) (exit-status - (call-process shell-file-name nil (list buffer nil) nil - shell-command-switch - (format (Man-build-man-command) man-args))) + (process-file + (Man-shell-file-name) nil (list buffer nil) nil + shell-command-switch + (format (Man-build-man-command) man-args))) (msg "")) (or (and (numberp exit-status) (= exit-status 0)) @@ -1160,9 +1256,10 @@ Return the buffer in which the manpage will appear." (buffer-read-only nil)) (erase-buffer) (Man-start-calling - (call-process shell-file-name nil (list (current-buffer) nil) nil - shell-command-switch - (format (Man-build-man-command) Man-arguments))) + (process-file + (Man-shell-file-name) nil (list (current-buffer) nil) nil + shell-command-switch + (format (Man-build-man-command) Man-arguments))) (if Man-fontify-manpage-flag (Man-fontify-manpage) (Man-cleanup-manpage)) @@ -1262,21 +1359,21 @@ Same for the ANSI bold and normal escape sequences." (progn (goto-char (point-min)) (while (and (search-forward "__\b\b" nil t) (not (eobp))) - (backward-delete-char 4) + (delete-char -4) (put-text-property (point) (1+ (point)) 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b\b__" nil t) - (backward-delete-char 4) + (delete-char -4) (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)))) (goto-char (point-min)) (while (and (search-forward "_\b" nil t) (not (eobp))) - (backward-delete-char 2) + (delete-char -2) (put-text-property (point) (1+ (point)) 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b_" nil t) - (backward-delete-char 2) + (delete-char -2) (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t) @@ -1294,7 +1391,7 @@ Same for the ANSI bold and normal escape sequences." ;; condense it to a shorter line interspersed with ^H. Remove ^H with ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) (goto-char (point-min)) - (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) + (while (re-search-forward ".\b" nil t) (delete-char -2)) (goto-char (point-min)) ;; Try to recognize common forms of cross references. (Man-highlight-references) @@ -1375,9 +1472,9 @@ script would have done them." (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) - (while (search-forward "_\b" nil t) (backward-delete-char 2)) + (while (search-forward "_\b" nil t) (delete-char -2)) (goto-char (point-min)) - (while (search-forward "\b_" nil t) (backward-delete-char 2)) + (while (search-forward "\b_" nil t) (delete-char -2)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t) (replace-match "\\1")) @@ -1392,7 +1489,7 @@ script would have done them." ;; condense it to a shorter line interspersed with ^H. Remove ^H with ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) (goto-char (point-min)) - (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) + (while (re-search-forward ".\b" nil t) (delete-char -2)) (Man-softhyphen-to-minus)) (defun Man-bgproc-filter (process string) @@ -1926,7 +2023,7 @@ Specify which REFERENCE to use; default is based on word at point." ;; Header file support (defun Man-view-header-file (file) "View a header file specified by FILE from `Man-header-file-path'." - (let ((path Man-header-file-path) + (let ((path (Man-header-file-path)) complete-path) (while path (setq complete-path (expand-file-name file (car path)) |