changeset 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.
author Eli Zaretskii <eliz@gnu.org>
date Mon, 03 Feb 1997 18:02:26 +0000
parents 99de1dc68184
children f4eb94106c89
files lisp/man.el
diffstat 1 files changed, 51 insertions(+), 20 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/man.el	Mon Feb 03 09:45:27 1997 +0000
+++ b/lisp/man.el	Mon Feb 03 18:02:26 1997 +0000
@@ -397,7 +397,14 @@
 
 (defsubst Man-build-man-command ()
   "Builds the entire background manpage and cleaning command."
-  (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
+  (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)))
@@ -534,10 +541,24 @@
       (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)))))
+	(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.
@@ -647,13 +668,20 @@
   (message "%s man page cleaned up" Man-arguments))
 
 (defun Man-bgproc-sentinel (process msg)
-  "Manpage background process sentinel."
-  (let ((Man-buffer (process-buffer process))
+  "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
-	(set-process-buffer process nil)
+	(or (stringp process)
+	    (set-process-buffer process nil))
 
       (save-excursion
 	(set-buffer Man-buffer)
@@ -665,17 +693,20 @@
 						  (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))
-		 )))
+		((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
@@ -684,7 +715,7 @@
           (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.