Package: emacs;
Reported by: Leo Liu <sdl.web <at> gmail.com>
Date: Sun, 22 Jun 2014 13:32:02 UTC
Severity: normal
Found in version 24.0.50
Fixed in version 24.4.50
Done: Juri Linkov <juri <at> jurta.org>
Bug is archived. No further changes may be made.
Message #84 received at 17831 <at> debbugs.gnu.org (full text, mbox):
From: Juri Linkov <juri <at> jurta.org> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: rudalics <at> gmx.at, Eli Zaretskii <eliz <at> gnu.org>, 17831 <at> debbugs.gnu.org, sdl.web <at> gmail.com Subject: Re: bug#17831: 24.4.50; bad default value for `Man-width' Date: Mon, 30 Jun 2014 02:42:28 +0300
>> But still the users need an indication that the formatting
>> is not finished. grep/compilation and vc display a string
>> like "waiting..." or "compiling..." in the mode-line, so
>> man.el could display in the mode-line "formatting..."
>
> Sound fine,
After testing I see no problems with this patch:
=== modified file 'lisp/man.el'
--- lisp/man.el 2014-05-09 07:02:00 +0000
+++ lisp/man.el 2014-06-29 23:37:38 +0000
@@ -1056,21 +1056,28 @@ (defun Man-getpage-in-background (topic)
(require 'env)
(message "Invoking %s %s in the background" manual-program man-args)
(setq buffer (generate-new-buffer bufname))
+ (Man-notify-when-ready buffer)
(with-current-buffer buffer
(setq buffer-undo-list t)
(setq Man-original-frame (selected-frame))
- (setq Man-arguments man-args))
+ (setq Man-arguments man-args)
+ (Man-mode)
+ (setq mode-line-process
+ (concat " " (propertize "[formatting...]"
+ 'face 'mode-line-emphasis))))
(Man-start-calling
(if (fboundp 'start-process)
- (set-process-sentinel
- (start-process manual-program buffer
+ (let ((proc (start-process
+ manual-program buffer
(if (memq system-type '(cygwin windows-nt))
shell-file-name
"sh")
shell-command-switch
- (format (Man-build-man-command) man-args))
- 'Man-bgproc-sentinel)
- (let ((exit-status
+ (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)))
@@ -1082,6 +1089,10 @@ (defun Man-getpage-in-background (topic)
(format "exited abnormally with code %d"
exit-status)))
(setq msg exit-status))
+ (with-current-buffer buffer
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage)))
(Man-bgproc-sentinel bufname msg)))))
buffer))
@@ -1168,7 +1179,6 @@ (defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
(interactive)
- (message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function
@@ -1183,7 +1193,7 @@ (defun Man-fontify-manpage ()
;; Multibyte characters exist.
(progn
(goto-char (point-min))
- (while (search-forward "__\b\b" nil t)
+ (while (and (search-forward "__\b\b" nil t) (not (eobp)))
(backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
@@ -1191,7 +1201,7 @@ (defun Man-fontify-manpage ()
(backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min))
- (while (search-forward "_\b" nil t)
+ (while (and (search-forward "_\b" nil t) (not (eobp)))
(backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
@@ -1223,8 +1233,7 @@ (defun Man-fontify-manpage ()
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
- 'face 'Man-overstrike)))
- (message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
+ 'face 'Man-overstrike))))
(defun Man-highlight-references (&optional xref-man-type)
"Highlight the references on mouse-over.
@@ -1286,8 +1295,6 @@ (defun Man-cleanup-manpage (&optional in
but when called interactively, do those jobs even if the sed
script would have done them."
(interactive "p")
- (message "Please wait: cleaning up the %s man page..."
- Man-arguments)
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
@@ -1309,8 +1316,36 @@ (defun Man-cleanup-manpage (&optional in
;; 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))
- (Man-softhyphen-to-minus)
- (message "%s man page cleaned up" Man-arguments))
+ (Man-softhyphen-to-minus))
+
+(defun Man-bgproc-filter (process string)
+ "Manpage background process filter.
+When manpage command is run asynchronously, PROCESS is the process
+object for the manpage command; when manpage command is run
+synchronously, PROCESS is the name of the buffer where the manpage
+command is run. Second argument STRING is the entire string of output."
+ (save-excursion
+ (let ((Man-buffer (process-buffer process)))
+ (if (null (buffer-name Man-buffer)) ;; deleted buffer
+ (set-process-buffer process nil)
+
+ (with-current-buffer Man-buffer
+ (let ((inhibit-read-only t)
+ (beg (marker-position (process-mark process))))
+ (save-excursion
+ (goto-char beg)
+ (insert string)
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (goto-char beg)
+ (line-beginning-position))
+ (point))
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage)))
+ (set-marker (process-mark process) (point-max)))))))))
(defun Man-bgproc-sentinel (process msg)
"Manpage background process sentinel.
@@ -1329,6 +1364,7 @@ (defun Man-bgproc-sentinel (process msg)
(set-process-buffer process nil))
(with-current-buffer Man-buffer
+ (save-excursion
(let ((case-fold-search nil))
(goto-char (point-min))
(cond ((or (looking-at "No \\(manual \\)*entry for")
@@ -1364,28 +1400,34 @@ (defun Man-bgproc-sentinel (process msg)
(insert (format "\nprocess %s" msg))))
))
(if delete-buff
- (kill-buffer Man-buffer)
- (if Man-fontify-manpage-flag
- (Man-fontify-manpage)
- (Man-cleanup-manpage))
+ (if (get-buffer-window Man-buffer)
+ (quit-window t (get-buffer-window Man-buffer))
+ (kill-buffer Man-buffer))
(run-hooks 'Man-cooked-hook)
- (Man-mode)
+
+ (Man-build-page-list)
+ (Man-strip-page-headers)
+ (Man-unindent)
+ (Man-goto-page 1 t)
(if (not Man-page-list)
(let ((args Man-arguments))
- (kill-buffer (current-buffer))
- (user-error "Can't find the %s manpage"
+ (if (get-buffer-window (current-buffer))
+ (quit-window t (get-buffer-window (current-buffer)))
+ (kill-buffer (current-buffer)))
+ (message "Can't find the %s manpage"
(Man-page-from-arguments args)))
- (set-buffer-modified-p nil))))
- ;; Restore case-fold-search before calling
- ;; Man-notify-when-ready because it may switch buffers.
- (if (not delete-buff)
- (Man-notify-when-ready Man-buffer))
+ (if Man-fontify-manpage-flag
+ (message "%s man page formatted" (Man-page-from-arguments Man-arguments))
+ (message "%s man page cleaned up" Man-arguments))
+ (unless (and (processp process) (not (eq (process-status process) 'exit)))
+ (setq mode-line-process nil))
+ (set-buffer-modified-p nil)))))
(if err-mess
- (error "%s" err-mess))
+ (message "%s" err-mess))
))))
(defun Man-page-from-arguments (args)
@@ -1458,11 +1500,7 @@ (define-derived-mode Man-mode fundamenta
(set (make-local-variable 'outline-regexp) Man-heading-regexp)
(set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'bookmark-make-record-function)
- 'Man-bookmark-make-record)
- (Man-build-page-list)
- (Man-strip-page-headers)
- (Man-unindent)
- (Man-goto-page 1 t))
+ 'Man-bookmark-make-record))
(defsubst Man-build-section-alist ()
"Build the list of manpage sections."
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.