From: yamaoka <yamaoka>
Date: Fri, 16 Apr 1999 12:08:23 +0000 (+0000)
Subject: * mime-play.el (mime-show-echo-buffer): Make it returns the list of window,
X-Git-Tag: semi-pgpgpg_12
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=395c2ad7a4ed1b3b6a276099ac21ee810a9fe21f;p=elisp%2Fsemi.git

* mime-play.el (mime-show-echo-buffer): Make it returns the list of window,
start and end positions of inserted text; adjust a window height to the value
of `mime-echo-window-height' whenever this function is called; bind
`window-min-height' to 1 during splitting a window vertically.

* mime-pgp.el (mime-pgp-fetch-key): Enclose a tcp process with a temp buffer.
(mime-pgp-show-fetched-key-for-pgp50): Always use `mime-show-echo-buffer' for
displaying a fetched key; optimize its window height.
(mime-pgp-show-fetched-key): Likewise.
(mime-pgp-keyserver-port): Replace "HTTP" with "HKP" in doc string.
(mime-verify-application/pgp-signature): Optimize a height of window where
some informations are displayed.
(mime-pgp-parse-verify-error): Likewise.
(mime-pgp-show-echo-buffer): New macro.
(mime-pgp-parse-verify-error-for-pgp): Make it to accept an arg
`output-buffer' and to return the list of expected key-ID, start position and
lines to be shown a result.
(mime-pgp-parse-verify-error-for-pgp50): Likewise.
(mime-pgp-parse-verify-error-for-gpg): Likewise.
(mime-pgp-parse-verify-error): Likewise.
(mime-pgp-check-signature): Returns a start position and lines to be used for
how a result should be displayed in echo window.
(mime-pgp-detect-version): Bug fix -- save restriction before narrowing.
---

diff --git a/ChangeLog b/ChangeLog
index da114dd..d8430ce 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,32 @@
 1999-04-16  Katsumi Yamaoka   <yamaoka@jpl.org>
 
-	* mime-pgp.el (mime-pgp-detect-version): Bug fix -- save
-	restriction before narrowing.
+	* mime-play.el (mime-show-echo-buffer): Make it returns the list of
+	window, start and end positions of inserted text; adjust a window
+	height to the value of `mime-echo-window-height' whenever this
+	function is called; bind `window-min-height' to 1 during splitting
+	a window vertically.
+
+	* mime-pgp.el (mime-pgp-fetch-key): Enclose a tcp process with
+	a temp buffer.
+	(mime-pgp-show-fetched-key-for-pgp50): Always use
+	`mime-show-echo-buffer' for displaying a fetched key; optimize its
+	window height.
+	(mime-pgp-show-fetched-key): Likewise.
+	(mime-pgp-keyserver-port): Replace "HTTP" with "HKP" in doc string.
+	(mime-verify-application/pgp-signature): Optimize a height of window
+	where some informations are displayed.
+	(mime-pgp-parse-verify-error): Likewise.
+	(mime-pgp-show-echo-buffer): New macro.
+	(mime-pgp-parse-verify-error-for-pgp): Make it to accept an arg
+	`output-buffer' and to return the list of expected key-ID, start
+	position and lines to be shown a result.
+	(mime-pgp-parse-verify-error-for-pgp50): Likewise.
+	(mime-pgp-parse-verify-error-for-gpg): Likewise.
+	(mime-pgp-parse-verify-error): Likewise.
+	(mime-pgp-check-signature): Returns a start position and lines
+	to be used for how a result should be displayed in echo window.
+	(mime-pgp-detect-version): Bug fix -- save restriction before
+	narrowing.
 
 1999-04-15  Katsumi Yamaoka   <yamaoka@jpl.org>
 
diff --git a/mime-pgp.el b/mime-pgp.el
index 573d7b5..f20408f 100644
--- a/mime-pgp.el
+++ b/mime-pgp.el
@@ -299,13 +299,12 @@ or \"v\" for choosing a command of PGP 5.0i."
 	      )))
 
 (defun mime-pgp-detect-version ()
-  "Detect PGP version in the buffer. The buffer is expected to be narrowed
+  "Detect PGP version in the buffer.  The buffer is expected to be narrowed
 to just an ascii armor."
-  (let (version)
-    (save-restriction
-      (std11-narrow-to-header)
-      (setq version (std11-fetch-field "Version"))
-      )
+  (let ((version (save-restriction
+		   (std11-narrow-to-header)
+		   (std11-fetch-field "Version")
+		   )))
     (cond ((not version)
 	   pgp-version)
 	  ((string-match "GnuPG" version)
@@ -324,7 +323,8 @@ to just an ascii armor."
     (mime-pgp-detect-version)
     ))
 
-(defun mime-pgp-check-signature (output-buffer orig-file)
+(defun mime-pgp-check-signature (output-buffer orig-file
+					       &optional hide-lines)
   (with-current-buffer output-buffer
     (erase-buffer)
     (setq truncate-lines t))
@@ -346,80 +346,103 @@ to just an ascii armor."
 	 (good-post-function (mime-pgp-good-signature-post-function))
 	 (bad-regexp (mime-pgp-bad-signature-regexp))
 	 (bad-post-function (mime-pgp-bad-signature-post-function))
-	 status
+	 status start lines
 	 )
     (setq status (apply 'call-process-region (point-min) (point-max)
 			command nil output-buffer nil args)
 	  )
     (with-current-buffer output-buffer
       (goto-char (point-min))
+      (forward-line (or hide-lines 0))
+      (setq start (point)
+	    lines (count-lines start (point-max)))
       (cond ((not (stringp good-regexp))
 	     (message "Please specify right regexp for specified language")
+	     (cons start lines)
 	     )
-	    ((and (zerop status) (re-search-forward good-regexp nil t))
+	    ((and (zerop status)
+		  (progn
+		    (goto-char (point-min))
+		    (re-search-forward good-regexp nil t)
+		    ))
 	     (message (if good-post-function
 			  (funcall good-post-function)
 			(buffer-substring (match-beginning 0)
 					  (match-end 0))))
-	     (goto-char (point-min))
+	     (cons start lines)
 	     )
 	    ((not (stringp bad-regexp))
 	     (message "Please specify right regexp for specified language")
+	     (cons start lines)
 	     )
-	    ((re-search-forward bad-regexp nil t)
+	    ((progn
+	       (goto-char (point-min))
+	       (re-search-forward bad-regexp nil t)
+	       )
 	     (message (if bad-post-function
 			  (funcall bad-post-function)
 			(buffer-substring (match-beginning 0)
 					  (match-end 0))))
-	     (goto-char (point-min))
+	     (cons start lines)
 	     )
 	    (t
 	     ;; Returns nil in order for attempt to fetch key.
 	     nil
 	     )))))
 
-(defmacro mime-pgp-parse-verify-error (&rest forms)
-  (` (with-current-buffer mime-echo-buffer-name
-       (goto-char (point-min))
-       (prog1
-	   (let ((regexp (mime-pgp-key-expected-regexp)))
-	     (cond
-	      ((not (stringp regexp))
-	       (message "Please specify right regexp for specified language")
-	       nil
-	       )
-	      ((re-search-forward regexp nil t)
-	       (concat "0x" (buffer-substring-no-properties
-			     (match-beginning 1) (match-end 1)))
-	       )))
+(defmacro mime-pgp-parse-verify-error (output-buffer &rest forms)
+  (` (let ((regexp (mime-pgp-key-expected-regexp))
+	   keyid)
+       (with-current-buffer (, output-buffer)
 	 (goto-char (point-min))
+	 (if (stringp regexp)
+	     (if (re-search-forward regexp nil t)
+		 (progn
+		   (setq keyid (concat
+				"0x"
+				(buffer-substring-no-properties
+				 (match-beginning 1) (match-end 1))))
+		   (goto-char (point-min))
+		   ))
+	   (message "Please specify right regexp for specified language")
+	   )
 	 (,@ forms)
-	 (set-window-start
-	  (get-buffer-window mime-echo-buffer-name) (point))
+	 (list keyid (point) (count-lines (point) (point-max)))
 	 ))))
 
-(defun mime-pgp-parse-verify-error-for-gpg ()
-  "Subroutine used for parsing verify error with GnuPG.  Returns expected
-key-ID if it is found."
-  (mime-pgp-parse-verify-error)
+(defun mime-pgp-parse-verify-error-for-gpg (output-buffer)
+  "Subroutine used for parsing verify error with GnuPG.  Returns the
+list of expected key-ID, start position and lines to be shown a result."
+  (mime-pgp-parse-verify-error output-buffer)
   )
 
-(defun mime-pgp-parse-verify-error-for-pgp50 ()
-  "Subroutine used for parsing verify error with PGP 5.0i.  Returns expected
-key-ID if it is found."
-  (mime-pgp-parse-verify-error
-   (forward-line 1)
-   ))
+(defun mime-pgp-parse-verify-error-for-pgp50 (output-buffer)
+  "Subroutine used for parsing verify error with PGP 5.0i.  Returns the
+list of expected key-ID, start position and lines to be shown a result."
+  (mime-pgp-parse-verify-error output-buffer (forward-line 1))
+  )
 
-(defun mime-pgp-parse-verify-error-for-pgp ()
-  "Subroutine used for parsing verify error with PGP 2.6.  Returns expected
-key-ID if it is found."
+(defun mime-pgp-parse-verify-error-for-pgp (output-buffer)
+  "Subroutine used for parsing verify error with PGP 2.6.  Returns the
+list of expected key-ID, start position and lines to be shown a result."
   (mime-pgp-parse-verify-error
+   output-buffer
    (if (search-forward "\C-g" nil t)
        (goto-char (match-beginning 0))
      (forward-line 7))
    ))
 
+(defmacro mime-pgp-show-echo-buffer (start lines)
+  (` (let ((mime-echo-window-height
+	    (min (+ 2 (, lines))
+		 (max window-min-height
+		      (- (window-height) window-min-height)
+		      ))))
+       (set-window-start
+	(car (save-current-buffer (mime-show-echo-buffer)))
+	(, start))
+       )))
+
 (defun mime-verify-application/pgp-signature (entity situation)
   "Internal method to check PGP/MIME signature."
   (let* ((entity-node-id (mime-entity-node-id entity))
@@ -433,30 +456,37 @@ key-ID if it is found."
 	 (orig-file (make-temp-name basename))
 	 (sig-file (concat orig-file ".sig"))
 	 (pgp-version (mime-entity-detect-pgp-version entity))
+	 (output-buffer (get-buffer-create mime-echo-buffer-name))
+	 (hide-lines (cdr (assq pgp-version
+				'((gpg . nil) (pgp50 . 1) (pgp . 10)))))
 	 (parser (intern (format "mime-pgp-parse-verify-error-for-%s"
 				 pgp-version)))
-	 pgp-id done)
+	 done return pgp-id)
     (mime-write-entity orig-entity orig-file)
-    (save-current-buffer (mime-show-echo-buffer))
     (mime-write-entity-content entity sig-file)
     (message "Checking signature...")
     (unwind-protect
 	(while (not done)
-	  (if (setq done (mime-pgp-check-signature
-			  mime-echo-buffer-name orig-file))
-	      (let ((other-window-scroll-buffer mime-echo-buffer-name))
-		(scroll-other-window
-		 (cdr (assq pgp-version
-			    '((gpg . 0) (pgp50 . 1) (pgp . 10)))))
+	  (if (setq return (mime-pgp-check-signature
+			    output-buffer orig-file hide-lines))
+	      (progn
+		(mime-pgp-show-echo-buffer (car return) (cdr return))
+		(setq done t)
 		)
 	    (if (and
 		 (not pgp-id)
-		 (setq pgp-id (funcall parser))
+		 (progn
+		   (setq return (funcall parser output-buffer))
+		   (mime-pgp-show-echo-buffer (nth 1 return)
+					      (nth 2 return))
+		   (setq pgp-id (car return))
+		   )
 		 (y-or-n-p (format "Key %s not found; attempt to fetch? "
 				   pgp-id))
 		 )
 		(funcall (pgp-function 'fetch-key) (cons nil pgp-id))
-	      (funcall parser)
+	      (setq return (funcall parser output-buffer))
+	      (mime-pgp-show-echo-buffer (nth 1 return) (nth 2 return))
 	      (setq done t)
 	      (message "Can't check signature")
 	      )))
@@ -521,7 +551,7 @@ key-ID if it is found."
   :type 'string)
 
 (defcustom mime-pgp-keyserver-port 11371
-  "Port on which the keyserver's HTTP daemon lives."
+  "Port on which the keyserver's HKP daemon lives."
   :group 'mime-pgp
   :type 'integer)
 
@@ -548,10 +578,9 @@ values of this variable and `mime-pgp-http-proxy-server-port' appropriately."
   :type 'integer)
 
 (defmacro mime-pgp-show-fetched-key (key scroll &rest args)
-  (` (let ((buffer (get-buffer-create "*fetched keys*"))
-	   start height window shrink)
-       (with-current-buffer buffer
-	 (erase-buffer)
+  (` (let ((current-window (selected-window))
+	   keys start hide return window)
+       (with-temp-buffer
 	 (insert (, key))
 	 (as-binary-process
 	  (call-process-region
@@ -559,40 +588,38 @@ values of this variable and `mime-pgp-http-proxy-server-port' appropriately."
 	  )
 	 (goto-char (point-min))
 	 (forward-line (, scroll))
-	 (setq height (count-lines (point) (point-max))
-	       start (point))
+	 (setq keys (buffer-string)
+	       start (point)
+	       hide (count-lines (point) (point-max)))
 	 )
-       (setq window (get-buffer-window mime-echo-buffer-name))
-       (if window
-	   (set-window-buffer window buffer)
-	 (let (pop-up-frames)
-	   (display-buffer buffer)
-	   ))
-       (setq window (get-buffer-window buffer)
-	     shrink (1- (- (window-height window) height)))
-       (if (> shrink 0)
-	   (let ((window-min-height 1))
-	     (enlarge-window shrink)
+       (setq return (mime-show-echo-buffer "%s" keys)
+	     window (car return)
+	     start (1- (+ start (car (cdr return))))
+	     hide (- (window-height window) hide 2))
+       (if (>= (+ (window-height current-window) hide) window-min-height)
+	   (progn
+	     (select-window window)
+	     (shrink-window hide)
+	     (select-window current-window)
 	     ))
        (set-window-start window start)
-       buffer)))
+       )))
 
 (defun mime-pgp-show-fetched-key-for-gpg (key)
-  "Extract KEY and show. Returns buffer object to be killed."
+  "Extract KEY and show."
   (mime-pgp-show-fetched-key key 0)
   )
 
 (defun mime-pgp-show-fetched-key-for-pgp50 (key)
-  "Extract KEY and show. Returns buffer object to be killed."
-  (let ((buffer (get-buffer-create "*fetched keys*"))
+  "Extract KEY and show."
+  (let ((current-window (selected-window))
 	(process-environment process-environment)
-	process-connection-type process start height window shrink)
+	process-connection-type process keys start hide return window)
     (setenv "PGPPASSFD" nil)
-    (with-current-buffer buffer
-      (erase-buffer)
+    (with-temp-buffer
       (setq process
 	    (start-process "*show fetched keys*"
-			   buffer (mime-pgp-command 'v)
+			   (current-buffer) (mime-pgp-command 'v)
 			   "-f" "+batchmode=0" "+language=us")
 	    )
       (set-process-coding-system process 'binary 'binary)
@@ -612,26 +639,25 @@ values of this variable and `mime-pgp-http-proxy-server-port' appropriately."
       (delete-region start (point-max))
       (goto-char (point-min))
       (forward-line 10)
-      (setq height (count-lines (point) start)
-	    start (point))
+      (setq keys (buffer-string)
+	    start (point)
+	    hide (count-lines (point) start))
       )
-    (setq window (get-buffer-window mime-echo-buffer-name))
-    (if window
-	(set-window-buffer window buffer)
-      (let (pop-up-frames)
-	(display-buffer buffer)
-	))
-    (setq window (get-buffer-window buffer)
-	  shrink (1- (- (window-height window) height)))
-    (if (> shrink 0)
-	(let ((window-min-height 1))
-	  (enlarge-window shrink)
+    (setq return (mime-show-echo-buffer "%s" keys)
+	  window (car return)
+	  start (1- (+ start (car (cdr return))))
+	  hide (- (window-height window) hide 2))
+    (if (>= (+ (window-height current-window) hide) window-min-height)
+	(progn
+	  (select-window window)
+	  (shrink-window hide)
+	  (select-window current-window)
 	  ))
     (set-window-start window start)
-    buffer))
+    ))
 
 (defun mime-pgp-show-fetched-key-for-pgp (key)
-  "Extract KEY and show. Returns buffer object to be killed."
+  "Extract KEY and show."
   (mime-pgp-show-fetched-key key 7 "-f" "+language=en")
   )
 
@@ -661,8 +687,7 @@ In addition, if you are behind firewalls, please set the values of
 `mime-pgp-http-proxy-server-address' and `mime-pgp-http-proxy-server-port'
 appropriately."
   (interactive)
-  (let ((buffer (get-buffer-create "*key fetch*"))
-	(server (or mime-pgp-http-proxy-server-address
+  (let ((server (or mime-pgp-http-proxy-server-address
 		    mime-pgp-keyserver-address))
 	(port (or mime-pgp-http-proxy-server-port
 		  mime-pgp-keyserver-port))
@@ -676,84 +701,73 @@ appropriately."
 	(show-function (intern (format "mime-pgp-show-fetched-key-for-%s"
 				       pgp-version)))
 	(snarf-function (pgp-function 'snarf-keys))
-	(window-config (current-window-configuration))
-	case-fold-search process-connection-type process show-buffer)
-    (unwind-protect
-	(catch 'mime-pgp-fetch-key-done
-	  (cond ((interactive-p)
-		 (setq id (read-string "Fetch key for: "))
-		 (cond ((string-equal "" id)
-			(message "Aborted")
-			(throw 'mime-pgp-fetch-key-done nil)
-			)
-		       ((string-match "^0[Xx]" id)
-			(setq id (cons nil id))
-			)
-		       (t
-			(setq id (cons id nil))
-			)))
-		((or (null id)
-		     (not (or (stringp (car id)) (stringp (cdr id)))))
-		 (message "Aborted")
+	armor case-fold-search process-connection-type process start)
+    (if (cond ((interactive-p)
+	       (setq id (read-string "Fetch key for: "))
+	       (cond ((string-equal "" id)
+		      (message "Aborted")
+		      nil)
+		     ((string-match "^0[Xx]" id)
+		      (setq id (cons nil id)))
+		     (t
+		      (setq id (cons id nil)))))
+	      ((or (null id)
+		   (not (or (stringp (car id)) (stringp (cdr id)))))
+	       (message "Aborted")
+	       nil)
+	      (t t))
+	(progn
+	  (with-temp-buffer
+	    (catch 'mime-pgp-fetch-key-done
+	      (message "Fetching %s via HTTP to %s..."
+		       (or (cdr id) (car id))
+		       mime-pgp-keyserver-address)
+	      (condition-case err
+		  (setq process (open-network-stream-as-binary
+				 "*key fetch*" (current-buffer) server port))
+		(error
+		 (message "%s" err)
 		 (throw 'mime-pgp-fetch-key-done nil)
 		 ))
-	  (with-current-buffer buffer
-	    (erase-buffer)
-	    (message "Fetching %s via HTTP to %s..."
-		     (or (cdr id) (car id))
-		     mime-pgp-keyserver-address
-		     )
-	    (condition-case err
-		(setq process (open-network-stream-as-binary
-			       "*key fetch*" buffer server port)
-		      )
-	      (error
-	       (message "%s" err)
-	       (throw 'mime-pgp-fetch-key-done nil)
-	       ))
-	    (if (not process)
-		(progn
-		  (message "Can't connect to %s%s."
-			   mime-pgp-keyserver-address
-			   (if mime-pgp-http-proxy-server-address
-			       (concat "via "
-				       mime-pgp-http-proxy-server-address)
-			     ""))
-		  (throw 'mime-pgp-fetch-key-done nil)
-		  )
-	      (process-send-string
-	       process
-	       (concat "GET " (format url-template
-				      (or (cdr id) (car id))) "\r\n")
-	       )
-	      (while (and (eq 'open (process-status process))
-			  (accept-process-output process
-						 mime-pgp-fetch-timeout)
-			  ))
-	      (delete-process process)
-	      (goto-char (point-min))
-	      (if (and (re-search-forward
-			"^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" nil t)
-		       (progn
-			 (delete-region (point-min) (match-beginning 0))
+	      (if (not process)
+		  (progn
+		    (message "Can't connect to %s%s."
+			     mime-pgp-keyserver-address
+			     (if mime-pgp-http-proxy-server-address
+				 (concat "via "
+					 mime-pgp-http-proxy-server-address)
+			       ""))
+		    (throw 'mime-pgp-fetch-key-done nil)
+		    )
+		(process-send-string
+		 process
+		 (concat "GET " (format url-template
+					(or (cdr id) (car id))) "\r\n")
+		 )
+		(while (and (eq 'open (process-status process))
+			    (accept-process-output process
+						   mime-pgp-fetch-timeout)
+			    ))
+		(delete-process process)
+		(goto-char (point-min))
+		(if (and (re-search-forward
+			  "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" nil t)
+			 (setq start (match-beginning 0))
 			 (re-search-forward
 			  "^-----END PGP PUBLIC KEY BLOCK-----\r?$" nil t)
-			 ))
-		  (progn
-		    (delete-region (1+ (match-end 0)) (point-max))
-		    (setq show-buffer
-			  (funcall show-function (buffer-string))
-			  )
-		    (if (y-or-n-p "Add this key to keyring? ")
-			(funcall snarf-function)
-		      )
-		    (kill-buffer show-buffer)
-		    t)
-		(message "Key not found.")
-		nil))))
-      (kill-buffer buffer)
-      (set-window-configuration window-config)
-      )))
+			 )
+		    (setq armor (buffer-substring start (1+ (point))))
+		  ))))
+	  (if armor
+	      (save-window-excursion
+		(funcall show-function armor)
+		(if (y-or-n-p "Add this key to keyring? ")
+		    (with-temp-buffer
+		      (insert armor)
+		      (funcall snarf-function)))
+		t)
+	    (message "Key not found.")
+	    nil)))))
 
 
 ;;; @ end
diff --git a/mime-play.el b/mime-play.el
index 12c8ad3..9f9a40f 100644
--- a/mime-play.el
+++ b/mime-play.el
@@ -383,33 +383,45 @@ Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
 window.")
 
 (defun mime-show-echo-buffer (&rest forms)
-  "Show mime-echo buffer to display MIME-playing information."
+  "Show mime-echo buffer to display MIME-playing information.
+It returns the list of window, start and end positions of inserted text.
+A window height of the buffer `mime-echo-buffer-name' will be determined
+by `mime-echo-window-height' (its value or its return value) whenever
+this function is called."
   (get-buffer-create mime-echo-buffer-name)
   (let ((the-win (selected-window))
-	(win (get-buffer-window mime-echo-buffer-name)))
-    (unless win
+	(win (get-buffer-window mime-echo-buffer-name))
+	(height (if (functionp mime-echo-window-height)
+		    (funcall mime-echo-window-height)
+		  mime-echo-window-height))
+	start)
+    (if win
+	(progn
+	  (select-window win)
+	  (enlarge-window (- height (window-height)))
+	  )
       (unless (and mime-echo-window-is-shared-with-bbdb
 		   (condition-case nil
-		       (setq win (get-buffer-window bbdb-buffer-name))
+		       (select-window
+			(setq win (get-buffer-window bbdb-buffer-name))
+			)
 		     (error nil)))
 	(select-window (get-buffer-window (or mime-preview-buffer
 					      (current-buffer))))
-	(setq win (split-window-vertically
-		   (- (window-height)
-		      (if (functionp mime-echo-window-height)
-			  (funcall mime-echo-window-height)
-			mime-echo-window-height)
-		      )))
-	)
-      (set-window-buffer win mime-echo-buffer-name)
-      )
-    (select-window win)
-    (goto-char (point-max))
+	(let ((window-min-height 1))
+	  (setq win (split-window-vertically (- (window-height) height)))
+	  )
+	(set-window-buffer win mime-echo-buffer-name)
+	(select-window win)
+	))
+    (goto-char (setq start (point-max)))
     (if forms
 	(insert (apply (function format) forms))
       )
-    (select-window the-win)
-    ))
+    (prog1
+	(list win start (point))
+      (select-window the-win)
+      )))
 
 
 ;;; @ file name