From: Daiki Ueno <ueno@gnu.org>
Date: Tue, 18 Aug 2015 02:09:29 +0000 (+0900)
Subject: pinentry.el: Popup window for multiline prompt
X-Git-Tag: emacs-25.0.90~1369
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9bc757830a9c6edeb950c294a32f058504550148;p=emacs.git

pinentry.el: Popup window for multiline prompt

* lisp/net/pinentry.el (pinentry): New custom group.
(pinentry-popup-prompt-window): New user option.
(pinentry-prompt-window-height): New user option.
(pinentry--prompt-buffer): New variable.
(pinentry-prompt-mode-map): New variable.
(pinentry-prompt-mode): New function.
(pinentry--prompt): New function.
(pinentry--process-filter): Use `pinentry--prompt' instead of
`read-passwd' and `y-or-n-p'.
---

diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el
index 7cbe9f50c4a..05cb124f2cb 100644
--- a/lisp/net/pinentry.el
+++ b/lisp/net/pinentry.el
@@ -50,6 +50,21 @@
 
 ;;; Code:
 
+(defgroup pinentry nil
+  "The Pinentry server"
+  :version "25.1"
+  :group 'external)
+
+(defcustom pinentry-popup-prompt-window t
+  "If non-nil, display status information from epa commands in another window."
+  :type 'boolean
+  :group 'pinentry)
+
+(defcustom pinentry-prompt-window-height 5
+  "Number of lines used to display status information."
+  :type 'integer
+  :group 'pinentry)
+
 (defvar pinentry--server-process nil)
 (defvar pinentry--connection-process-list nil)
 
@@ -58,6 +73,8 @@
 (defvar pinentry--read-point nil)
 (put 'pinentry--read-point 'permanent-local t)
 
+(defvar pinentry--prompt-buffer nil)
+
 ;; We use the same location as `server-socket-dir', when local sockets
 ;; are supported.
 (defvar pinentry--socket-dir
@@ -82,6 +99,52 @@ If local sockets are not supported, this is nil.")
 
 (autoload 'server-ensure-safe-dir "server")
 
+(defvar pinentry-prompt-mode-map
+  (let ((keymap (make-sparse-keymap)))
+    (define-key keymap "q" 'quit-window)
+    keymap))
+
+(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
+  "Major mode for `pinentry--prompt-buffer'."
+  (buffer-disable-undo)
+  (setq truncate-lines t
+	buffer-read-only t))
+
+(defun pinentry--prompt (prompt short-prompt query-function &rest query-args)
+  (if (and (string-match "\n" prompt)
+           pinentry-popup-prompt-window)
+      (save-window-excursion
+        (delete-other-windows)
+	(unless (and pinentry--prompt-buffer
+                     (buffer-live-p pinentry--prompt-buffer))
+	  (setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
+	(if (get-buffer-window pinentry--prompt-buffer)
+	    (delete-window (get-buffer-window pinentry--prompt-buffer)))
+	(with-current-buffer pinentry--prompt-buffer
+	  (let ((inhibit-read-only t)
+		buffer-read-only)
+	    (erase-buffer)
+	    (insert prompt))
+	  (pinentry-prompt-mode)
+	  (goto-char (point-min)))
+	(if (> (window-height)
+	       pinentry-prompt-window-height)
+	    (set-window-buffer (split-window nil
+                                             (- (window-height)
+                                                pinentry-prompt-window-height))
+			       pinentry--prompt-buffer)
+	  (pop-to-buffer pinentry--prompt-buffer)
+	  (if (> (window-height) pinentry-prompt-window-height)
+	      (shrink-window (- (window-height)
+                                pinentry-prompt-window-height))))
+        (prog1 (apply query-function short-prompt query-args)
+          (quit-window)))
+    (apply query-function
+           ;; Append a suffix to the prompt, which can be derived from
+           ;; SHORT-PROMPT.
+           (concat prompt (substring short-prompt -2))
+           query-args)))
+
 ;;;###autoload
 (defun pinentry-start ()
   "Start a Pinentry service.
@@ -267,16 +330,13 @@ Assuan protocol."
                    (if (setq entry (assq 'title pinentry--labels))
                        (setq prompt (format "[%s] %s"
                                             (cdr entry) prompt)))
-                   (if (string-match ":?[ \n]*\\'" prompt)
-                       (setq prompt (concat
-                                     (substring
-                                      prompt 0 (match-beginning 0)) ": ")))
                    (let (passphrase escaped-passphrase encoded-passphrase)
                      (unwind-protect
                          (condition-case nil
                              (progn
                                (setq passphrase
-				     (read-passwd prompt confirm))
+				     (pinentry--prompt prompt "Password: "
+                                                       #'read-passwd confirm))
                                (setq escaped-passphrase
                                      (pinentry--escape-string
                                       passphrase))
@@ -350,7 +410,7 @@ Assuan protocol."
                                        (substring
                                         prompt 0 (match-beginning 0)) " ")))
                      (if (condition-case nil
-                             (y-or-n-p prompt)
+                             (pinentry--prompt prompt "Confirm? " #'y-or-n-p)
                            (quit))
 			 (ignore-errors
 			   (process-send-string process "OK\n"))