unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Juri Linkov <juri@jurta.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 17831@debbugs.gnu.org, sdl.web@gmail.com
Subject: bug#17831: 24.4.50; bad default value for `Man-width'
Date: Mon, 30 Jun 2014 02:42:28 +0300	[thread overview]
Message-ID: <87zjgv5lln.fsf@mail.jurta.org> (raw)
In-Reply-To: <jwvy4whlt9q.fsf-monnier+emacsbugs@gnu.org> (Stefan Monnier's message of "Fri, 27 Jun 2014 21:30:50 -0400")

>> 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."






  reply	other threads:[~2014-06-29 23:42 UTC|newest]

Thread overview: 47+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2014-06-22 13:30 bug#17831: 24.4.50; bad default value for `Man-width' Leo Liu
2014-06-23 12:53 ` Stefan Monnier
2014-06-23 23:17   ` Juri Linkov
2014-06-24  1:26     ` Stefan Monnier
2014-06-24  7:13     ` martin rudalics
2014-06-24 12:53       ` Stefan Monnier
2014-06-24 15:55         ` Eli Zaretskii
2014-06-24 17:33           ` Stefan Monnier
2014-06-24 17:59             ` Eli Zaretskii
2014-06-25  6:54           ` martin rudalics
2014-06-24 15:46       ` Eli Zaretskii
2014-06-24 17:31         ` Stefan Monnier
2014-06-24 17:56           ` Eli Zaretskii
2014-06-24 19:35             ` Stefan Monnier
2014-06-24 20:06               ` Eli Zaretskii
2014-06-24 20:29                 ` Stefan Monnier
2014-06-24 23:48                   ` Juri Linkov
2014-06-25  3:11                     ` Stefan Monnier
2014-06-26 23:49                       ` Juri Linkov
2014-06-27  2:16                         ` Stefan Monnier
2014-06-27 23:45                           ` Juri Linkov
2014-06-28  1:30                             ` Stefan Monnier
2014-06-29 23:42                               ` Juri Linkov [this message]
2014-06-30  3:29                                 ` Stefan Monnier
2014-06-24 23:42             ` Juri Linkov
2014-06-25  6:54         ` martin rudalics
2014-06-24 23:44       ` bug#17809: 24.4.50; Completions display Juri Linkov
2014-06-25  6:54         ` martin rudalics
2014-06-26 23:41           ` Juri Linkov
2014-06-27  2:07             ` Stefan Monnier
2014-06-27  6:43               ` martin rudalics
2014-06-27 23:54                 ` Juri Linkov
2014-06-28  8:18                   ` martin rudalics
2014-06-29 23:47                     ` Juri Linkov
2014-07-01 23:30                     ` Juri Linkov
2014-07-04 23:40                     ` Juri Linkov
2014-07-06  4:32                       ` Stefan Monnier
2014-07-06 23:32                         ` Juri Linkov
2014-07-07  1:21                           ` Stefan Monnier
2014-07-07  1:24                           ` Stefan Monnier
2014-07-07  6:49                             ` Juri Linkov
2014-07-08  3:43                               ` Stefan Monnier
2014-07-08  8:03                                 ` Juri Linkov
2014-06-27  6:43             ` martin rudalics
2014-06-27 23:53               ` Juri Linkov
2014-06-28  8:17                 ` martin rudalics
2014-06-23 23:21   ` bug#17831: 24.4.50; bad default value for `Man-width' Leo Liu

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87zjgv5lln.fsf@mail.jurta.org \
    --to=juri@jurta.org \
    --cc=17831@debbugs.gnu.org \
    --cc=monnier@iro.umontreal.ca \
    --cc=sdl.web@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).