comparison lisp/man.el @ 16973:39569e1b84b2

(Man-build-man-command): When async processes aren't supported, don't redirect stderr via the shell. (Man-getpage-in-background, Man-bgproc-sentinel): Support for systems where async processes don't work.

16972:99de1dc68184

	  Man-current-page
	  (length Man-page-list)))

(defsubst Man-build-man-command ()
  "Builds the entire background manpage and cleaning command."
  (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
	(flist Man-filter-list))
    (while (and flist (car flist))
      (let ((pcom (car (car flist)))
	    (pargs (cdr (car flist))))
	(setq command

	(setq Man-original-frame (selected-frame))
	(setq Man-arguments man-args))
      (let ((process-environment (copy-sequence process-environment)))
	;; Prevent any attempt to use display terminal fanciness.
	(setenv "TERM" "dumb")
	(set-process-sentinel
	 (start-process manual-program buffer "sh" "-c"
			(format (Man-build-man-command) man-args))
	 'Man-bgproc-sentinel)))))

(defun Man-notify-when-ready (man-buffer)
  "Notify the user when MAN-BUFFER is ready.
See the variable `Man-notify-method' for the different notification behaviors."
  (let ((saved-frame (save-excursion

  (goto-char (point-min))
  (while (search-forward "\255" nil t) (replace-match "-"))
  (message "%s man page cleaned up" Man-arguments))

(defun Man-bgproc-sentinel (process msg)
  "Manpage background process sentinel."
  (let ((Man-buffer (process-buffer process))
	(delete-buff nil)
	(err-mess nil))

    (if (null (buffer-name Man-buffer)) ;; deleted buffer
	(set-process-buffer process nil)

      (save-excursion
	(set-buffer Man-buffer)
	(let ((case-fold-search nil))
	  (goto-char (point-min))

		     (looking-at "[^\n]*: nothing appropriate$"))
		 (setq err-mess (buffer-substring (point)
						  (progn
						    (end-of-line) (point)))
		       delete-buff t))
		((not (and (eq (process-status process) 'exit)
			   (= (process-exit-status process) 0)))
		 (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)
          (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))

16973:39569e1b84b2

	  Man-current-page
	  (length Man-page-list)))

(defsubst Man-build-man-command ()
  "Builds the entire background manpage and cleaning command."
  (let ((command (concat manual-program " " Man-switches
			 ; Stock MS-DOS shells cannot redirect stderr;
			 ; `call-process' below sends it to /dev/null,
			 ; so we don't need `2>' even with DOS shells
			 ; which do support stderr redirection.
			 (if (not (fboundp 'start-process))
			     " %s"
			   " %s 2>/dev/null")))
	(flist Man-filter-list))
    (while (and flist (car flist))
      (let ((pcom (car (car flist)))
	    (pargs (cdr (car flist))))
	(setq command

	(setq Man-original-frame (selected-frame))
	(setq Man-arguments man-args))
      (let ((process-environment (copy-sequence process-environment)))
	;; Prevent any attempt to use display terminal fanciness.
	(setenv "TERM" "dumb")
	(if (fboundp 'start-process)
	    (set-process-sentinel
	     (start-process manual-program buffer "sh" "-c"
			    (format (Man-build-man-command) man-args))
	     'Man-bgproc-sentinel)
	  (progn
	    (let ((exit-status
		   (call-process shell-file-name nil (list buffer nil) nil "-c"
				 (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))))))))

(defun Man-notify-when-ready (man-buffer)
  "Notify the user when MAN-BUFFER is ready.
See the variable `Man-notify-method' for the different notification behaviors."
  (let ((saved-frame (save-excursion

  (goto-char (point-min))
  (while (search-forward "\255" nil t) (replace-match "-"))
  (message "%s man page cleaned up" Man-arguments))

(defun Man-bgproc-sentinel (process msg)
  "Manpage background process sentinel.
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 MSG is the exit message of the
manpage command."
  (let ((Man-buffer (if (stringp process) (get-buffer process)
		      (process-buffer process)))
	(delete-buff nil)
	(err-mess nil))

    (if (null (buffer-name Man-buffer)) ;; deleted buffer
	(or (stringp process)
	    (set-process-buffer process nil))

      (save-excursion
	(set-buffer Man-buffer)
	(let ((case-fold-search nil))
	  (goto-char (point-min))

		     (looking-at "[^\n]*: nothing appropriate$"))
		 (setq err-mess (buffer-substring (point)
						  (progn
						    (end-of-line) (point)))
		       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)
          (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))