emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] trunk r117461: Display man pages immediately and use proce


From: Juri Linkov
Subject: [Emacs-diffs] trunk r117461: Display man pages immediately and use process-filter to format them asynchronously.
Date: Tue, 01 Jul 2014 23:55:08 +0000
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 117461
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/2588
committer: Juri Linkov <address@hidden>
branch nick: trunk
timestamp: Wed 2014-07-02 02:54:59 +0300
message:
  Display man pages immediately and use process-filter to format them 
asynchronously.
  * lisp/man.el (Man-width): Doc fix.
  (man): Doc fix.
  (Man-start-calling): Use `with-selected-window' to get
  `frame-width' and `window-width'.
  (Man-getpage-in-background): Call `Man-notify-when-ready'
  immediately after creating a new buffer.  Call `Man-mode' and set
  `mode-line-process' in the created buffer.  Set process-filter to
  `Man-bgproc-filter' in start-process branch.  In call-process branch
  call either `Man-fontify-manpage' or `Man-cleanup-manpage'.
  Use `Man-start-calling' inside `with-current-buffer'.
  (Man-fontify-manpage): Don't print messages.  Fix boundary condition.
  (Man-cleanup-manpage): Don't print messages.
  (Man-bgproc-filter): New function.
  (Man-bgproc-sentinel): Add `save-excursion' to keep point when
  user moved it during asynchronous formatting.  Move calls of
  `Man-fontify-manpage' and `Man-cleanup-manpage' to
  `Man-bgproc-filter'.  Move the call of `Man-mode' to
  `Man-getpage-in-background'.  Use `quit-restore-window'
  instead of `kill-buffer'.  Use `message' instead of `error'
  because errors are catched by process sentinel.
  (Man-mode): Move calls of `Man-build-page-list',
  `Man-strip-page-headers', `Man-unindent', `Man-goto-page' to
  `Man-bgproc-sentinel'.  Doc fix.  (Bug#2588, bug#5054, bug#9084, bug#17831)
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/man.el                    man.el-20091113204419-o5vbwnq5f7feedwu-582
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-07-01 18:48:24 +0000
+++ b/lisp/ChangeLog    2014-07-01 23:54:59 +0000
@@ -1,3 +1,31 @@
+2014-07-01  Juri Linkov  <address@hidden>
+
+       * man.el: Display man pages immediately and use process-filter
+       to format them asynchronously.
+       (Man-width): Doc fix.
+       (man): Doc fix.
+       (Man-start-calling): Use `with-selected-window' to get
+       `frame-width' and `window-width'.
+       (Man-getpage-in-background): Call `Man-notify-when-ready'
+       immediately after creating a new buffer.  Call `Man-mode' and set
+       `mode-line-process' in the created buffer.  Set process-filter to
+       `Man-bgproc-filter' in start-process branch.  In call-process branch
+       call either `Man-fontify-manpage' or `Man-cleanup-manpage'.
+       Use `Man-start-calling' inside `with-current-buffer'.
+       (Man-fontify-manpage): Don't print messages.  Fix boundary condition.
+       (Man-cleanup-manpage): Don't print messages.
+       (Man-bgproc-filter): New function.
+       (Man-bgproc-sentinel): Add `save-excursion' to keep point when
+       user moved it during asynchronous formatting.  Move calls of
+       `Man-fontify-manpage' and `Man-cleanup-manpage' to
+       `Man-bgproc-filter'.  Move the call of `Man-mode' to
+       `Man-getpage-in-background'.  Use `quit-restore-window'
+       instead of `kill-buffer'.  Use `message' instead of `error'
+       because errors are catched by process sentinel.
+       (Man-mode): Move calls of `Man-build-page-list',
+       `Man-strip-page-headers', `Man-unindent', `Man-goto-page' to
+       `Man-bgproc-sentinel'.  Doc fix.  (Bug#2588, bug#5054, bug#9084, 
bug#17831)
+
 2014-07-01  Mario Lang  <address@hidden>
 
        * net/gnutls.el (gnutls-negotiate): Prevent destructive modification of

=== modified file 'lisp/man.el'
--- a/lisp/man.el       2014-05-09 07:02:00 +0000
+++ b/lisp/man.el       2014-07-01 23:54:59 +0000
@@ -173,13 +173,12 @@
 
 (defcustom Man-width nil
   "Number of columns for which manual pages should be formatted.
-If nil, the width of the window selected at the moment of man
-invocation is used.  If non-nil, the width of the frame selected
-at the moment of man invocation is used.  The value also can be a
-positive integer."
+If nil, use the width of the window where the manpage is displayed.
+If non-nil, use the width of the frame where the manpage is displayed.
+The value also can be a positive integer for a fixed width."
   :type '(choice (const :tag "Window width" nil)
                  (const :tag "Frame width" t)
-                 (integer :tag "Specific width" :value 65))
+                 (integer :tag "Fixed width" :value 65))
   :group 'man)
 
 (defcustom Man-frame-parameters nil
@@ -930,12 +929,14 @@
 ;;;###autoload
 (defun man (man-args)
   "Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package.  It
-runs a Un*x command to retrieve and clean a manpage in the
+This command is the top-level command in the man package.
+It runs a Un*x command to retrieve and clean a manpage in the
 background and places the results in a `Man-mode' browsing
-buffer.  See variable `Man-notify-method' for what happens when
-the buffer is ready.  If a buffer already exists for this man
-page, it will display immediately.
+buffer.  The variable `Man-width' defines the number of columns in
+formatted manual pages.  The buffer is displayed immediately.
+The variable `Man-notify-method' defines how the buffer is displayed.
+If a buffer already exists for this man page, it will be displayed
+without running the man command.
 
 For a manpage from a particular section, use either of the
 following.  \"cat(1)\" is how cross-references appear and is
@@ -1030,15 +1031,22 @@
     ;;               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.
+      ;; Since the page buffer is displayed beforehand,
+      ;; we can select its window and get the window/frame width.
       (setenv "COLUMNS" (number-to-string
                         (cond
                          ((and (integerp Man-width) (> Man-width 0))
                           Man-width)
-                         (Man-width (frame-width))
-                         ((window-width))))))
+                         (Man-width
+                          (if (window-live-p (get-buffer-window 
(current-buffer) t))
+                              (with-selected-window (get-buffer-window 
(current-buffer) t)
+                                (frame-width))
+                            (frame-width)))
+                         (t
+                          (if (window-live-p (get-buffer-window 
(current-buffer) t))
+                              (with-selected-window (get-buffer-window 
(current-buffer) t)
+                                (window-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).
@@ -1057,33 +1065,45 @@
       (message "Invoking %s %s in the background" manual-program man-args)
       (setq buffer (generate-new-buffer bufname))
       (with-current-buffer buffer
+       (Man-notify-when-ready buffer)
        (setq buffer-undo-list t)
        (setq Man-original-frame (selected-frame))
-       (setq Man-arguments man-args))
-      (Man-start-calling
-       (if (fboundp 'start-process)
-           (set-process-sentinel
-            (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
-                (call-process 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))
-               (and (numberp exit-status)
-                    (setq msg
-                          (format "exited abnormally with code %d"
-                                  exit-status)))
-               (setq msg exit-status))
-           (Man-bgproc-sentinel bufname msg)))))
-      buffer))
+       (setq Man-arguments man-args)
+       (Man-mode)
+       (setq mode-line-process
+             (concat " " (propertize (if Man-fontify-manpage-flag
+                                         "[formatting...]"
+                                       "[cleaning...]")
+                                     'face 'mode-line-emphasis)))
+       (Man-start-calling
+        (if (fboundp 'start-process)
+            (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))))
+              (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)))
+                 (msg ""))
+            (or (and (numberp exit-status)
+                     (= exit-status 0))
+                (and (numberp exit-status)
+                     (setq msg
+                           (format "exited abnormally with code %d"
+                                   exit-status)))
+                (setq msg exit-status))
+            (if Man-fontify-manpage-flag
+                (Man-fontify-manpage)
+              (Man-cleanup-manpage))
+            (Man-bgproc-sentinel bufname msg))))))
+    buffer))
 
 (defun Man-update-manpage ()
   "Reformat current manpage by calling the man command again synchronously."
@@ -1168,7 +1188,6 @@
   "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 +1202,7 @@
        ;; 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 +1210,7 @@
            (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 +1242,7 @@
     (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 +1304,6 @@
 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 +1325,35 @@
   ;; 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,63 +1372,74 @@
            (set-process-buffer process nil))
 
       (with-current-buffer Man-buffer
-       (let ((case-fold-search nil))
-         (goto-char (point-min))
-         (cond ((or (looking-at "No \\(manual \\)*entry for")
-                    (looking-at "[^\n]*: nothing appropriate$"))
-                (setq err-mess (buffer-substring (point)
-                                                 (progn
-                                                   (end-of-line) (point)))
-                      delete-buff t))
-
-               ;; "-k foo", successful exit, but no output (from man-db)
-               ;; ENHANCE-ME: share the check for -k with
-               ;; `Man-highlight-references'.  The \\s- bits here are
-               ;; meant to allow for multiple options with -k among them.
-               ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments)
-                     (eq (process-status process) 'exit)
-                     (= (process-exit-status process) 0)
-                     (= (point-min) (point-max)))
-                (setq err-mess (format "%s: no matches" Man-arguments)
-                      delete-buff t))
-
-               ((or (stringp process)
-                    (not (and (eq (process-status process) 'exit)
-                              (= (process-exit-status process) 0))))
-                (or (zerop (length msg))
-                    (progn
-                      (setq err-mess
-                            (concat (buffer-name Man-buffer)
-                                    ": process "
-                                    (let ((eos (1- (length msg))))
-                                      (if (= (aref msg eos) ?\n)
-                                          (substring msg 0 eos) msg))))
-                      (goto-char (point-max))
-                      (insert (format "\nprocess %s" msg))))
-                ))
-        (if delete-buff
-            (kill-buffer Man-buffer)
-          (if Man-fontify-manpage-flag
-              (Man-fontify-manpage)
-            (Man-cleanup-manpage))
-
-          (run-hooks 'Man-cooked-hook)
-         (Man-mode)
-
-         (if (not Man-page-list)
-             (let ((args Man-arguments))
-               (kill-buffer (current-buffer))
-               (user-error "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))
+       (save-excursion
+         (let ((case-fold-search nil))
+           (goto-char (point-min))
+           (cond ((or (looking-at "No \\(manual \\)*entry for")
+                      (looking-at "[^\n]*: nothing appropriate$"))
+                  (setq err-mess (buffer-substring (point)
+                                                   (progn
+                                                     (end-of-line) (point)))
+                        delete-buff t))
+
+                 ;; "-k foo", successful exit, but no output (from man-db)
+                 ;; ENHANCE-ME: share the check for -k with
+                 ;; `Man-highlight-references'.  The \\s- bits here are
+                 ;; meant to allow for multiple options with -k among them.
+                 ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments)
+                       (eq (process-status process) 'exit)
+                       (= (process-exit-status process) 0)
+                       (= (point-min) (point-max)))
+                  (setq err-mess (format "%s: no matches" Man-arguments)
+                        delete-buff t))
+
+                 ((or (stringp process)
+                      (not (and (eq (process-status process) 'exit)
+                                (= (process-exit-status process) 0))))
+                  (or (zerop (length msg))
+                      (progn
+                        (setq err-mess
+                              (concat (buffer-name Man-buffer)
+                                      ": process "
+                                      (let ((eos (1- (length msg))))
+                                        (if (= (aref msg eos) ?\n)
+                                            (substring msg 0 eos) msg))))
+                        (goto-char (point-max))
+                        (insert (format "\nprocess %s" msg))))
+                  ))
+           (if delete-buff
+               (if (window-live-p (get-buffer-window Man-buffer t))
+                   (quit-restore-window
+                    (get-buffer-window Man-buffer t) 'kill)
+                 (kill-buffer Man-buffer))
+
+             (run-hooks 'Man-cooked-hook)
+
+             (Man-build-page-list)
+             (Man-strip-page-headers)
+             (Man-unindent)
+             (Man-goto-page 1 t)
+
+             (if (not Man-page-list)
+                 (let ((args Man-arguments))
+                   (if (window-live-p (get-buffer-window (current-buffer) t))
+                       (quit-restore-window
+                        (get-buffer-window (current-buffer) t) 'kill)
+                     (kill-buffer (current-buffer)))
+                   (message "Can't find the %s manpage"
+                            (Man-page-from-arguments args)))
+
+               (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)
@@ -1429,7 +1483,7 @@
 The following variables may be of some use.  Try
 \"\\[describe-variable] <variable-name> RET\" for more information:
 
-`Man-notify-method'            What happens when manpage formatting is done.
+`Man-notify-method'            What happens when manpage is ready to display.
 `Man-downcase-section-letters-flag' Force section letters to lower case.
 `Man-circular-pages-flag'      Treat multiple manpage list as circular.
 `Man-section-translations-alist' List of section numbers and their Un*x equiv.
@@ -1458,11 +1512,7 @@
   (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."
@@ -1516,7 +1566,6 @@
        (page-end (point-max))
        (header ""))
     (goto-char page-start)
-    ;; (switch-to-buffer (current-buffer))(debug)
     (while (not (eobp))
       (setq header
            (if (looking-at Man-page-header-regexp)


reply via email to

[Prev in Thread] Current Thread [Next in Thread]