mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/man.el (Man-start-calling): New macro, extracted from

Browse source 
Man-getpage-in-background.
(Man-getpage-in-background): Use it.
(Man-update-manpage): New command.
(Man-mode-map): Bind it.
This commit is contained in:
Darren Hoo 2013-11-07 23:09:56 -05:00 • committed by Stefan Monnier
parent d85783ca32
commit daddb3fd83
2 changed files with 87 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

123
lisp/man.el
View file

@ -448,6 +448,7 @@ Otherwise, the value is whatever the function
(define-key map "s" 'Man-goto-see-also-section)
(define-key map "k" 'Man-kill)
(define-key map "q" 'Man-quit)
(define-key map "u" 'Man-update-manpage)
(define-key map "m" 'man)
;; Not all the man references get buttons currently. The text in the
;; manual page can contain references to other man pages
@ -1000,6 +1001,52 @@ names or descriptions. The pattern argument is usually an
(error "No item under point")
(man man-args)))
(defmacro Man-start-calling (&rest body)
"Start the man command in `body' after setting up the environment"
`(let ((process-environment (copy-sequence process-environment))
;; The following is so Awk script gets \n intact
;; But don't prevent decoding of the outside.
(coding-system-for-write 'raw-text-unix)
;; We must decode the output by a coding system that the
;; system's locale suggests in multibyte mode.
(coding-system-for-read 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
"/")))
;; Prevent any attempt to use display terminal fanciness.
(setenv "TERM" "dumb")
;; In Debian Woody, at least, we get overlong lines under X
;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
;; a tty. man(1) says:
;; MANWIDTH
;; If $MANWIDTH is set, its value is used as the line
;; length for which manual pages should be formatted.
;; If it is not set, manual pages will be formatted
;; with a line length appropriate to the current ter-
;; minal (using an ioctl(2) if available, the value of
;; $COLUMNS, or falling back to 80 characters if nei-
;; ther is available).
(when (or window-system
(not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
;; This isn't strictly correct, since we don't know how
;; the page will actually be displayed, but it seems
;; reasonable.
(setenv "COLUMNS" (number-to-string
(cond
((and (integerp Man-width) (> Man-width 0))
Man-width)
(Man-width (frame-width))
((window-width))))))
;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673).
(setenv "MAN_KEEP_FORMATTING" "1")
,@body))
(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."
@ -1015,51 +1062,8 @@ Return the buffer in which the manpage will appear."
(setq buffer-undo-list t)
(setq Man-original-frame (selected-frame))
(setq Man-arguments man-args))
(let ((process-environment (copy-sequence process-environment))
;; The following is so Awk script gets \n intact
;; But don't prevent decoding of the outside.
(coding-system-for-write 'raw-text-unix)
;; We must decode the output by a coding system that the
;; system's locale suggests in multibyte mode.
(coding-system-for-read
(if (default-value 'enable-multibyte-characters)
locale-coding-system 'raw-text-unix))
;; 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
"/")))
;; Prevent any attempt to use display terminal fanciness.
(setenv "TERM" "dumb")
;; In Debian Woody, at least, we get overlong lines under X
;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
;; a tty. man(1) says:
;; MANWIDTH
;; If $MANWIDTH is set, its value is used as the line
;; length for which manual pages should be formatted.
;; If it is not set, manual pages will be formatted
;; with a line length appropriate to the current ter-
;; minal (using an ioctl(2) if available, the value of
;; $COLUMNS, or falling back to 80 characters if nei-
;; ther is available).
(when (or window-system
(not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
;; This isn't strictly correct, since we don't know how
;; the page will actually be displayed, but it seems
;; reasonable.
(setenv "COLUMNS" (number-to-string
(cond
((and (integerp Man-width) (> Man-width 0))
Man-width)
(Man-width (frame-width))
((window-width))))))
;; Since man-db 2.4.3-1, man writes plain text with no escape
;; sequences when stdout is not a tty. In 2.5.0, the following
;; env-var was added to allow control of this (see Debian Bug#340673).
(setenv "MAN_KEEP_FORMATTING" "1")
(if (fboundp 'start-process)
(Man-start-calling
(if (fboundp 'start-process)
(set-process-sentinel
(start-process manual-program buffer
(if (memq system-type '(cygwin windows-nt))
@ -1081,7 +1085,34 @@ Return the buffer in which the manpage will appear."
exit-status)))
(setq msg exit-status))
(Man-bgproc-sentinel bufname msg)))))
buffer))
buffer))
(defun Man-update-manpage ()
"Reformat current manpage by calling the man command again synchronously."
(interactive)
(when (eq Man-arguments nil)
;;this shouldn't happen unless it is not in a Man buffer."
(error "Man-arguments not initialized"))
(let ((old-pos (point))
(text (current-word))
(old-size (buffer-size))
(inhibit-read-only t)
(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)))
(if Man-fontify-manpage-flag
(Man-fontify-manpage)
(Man-cleanup-manpage))
(goto-char old-pos)
;;restore the point, not strictly right.
(unless (or (eq text nil) (= old-size (buffer-size)))
(let ((case-fold-search nil))
(if (> old-size (buffer-size))
(search-backward text nil t))
(search-forward text nil t)))))
(defun Man-notify-when-ready (man-buffer)
"Notify the user when MAN-BUFFER is ready.