[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 1cfcece 01/11: packages/pinentry/pinentry.el: Popup window
From: |
Nicolas Petton |
Subject: |
[elpa] master 1cfcece 01/11: packages/pinentry/pinentry.el: Popup window for multiline prompt |
Date: |
Tue, 16 Jan 2018 08:01:43 -0500 (EST) |
branch: master
commit 1cfcece832d095005911c70c52d58b5dcf41ebb9
Author: Daiki Ueno <address@hidden>
Commit: Nicolas Petton <address@hidden>
packages/pinentry/pinentry.el: Popup window for multiline prompt
* packages/pinentry/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'.
---
packages/pinentry/pinentry.el | 72 +++++++++++++++++++++++++++++++++++++++----
1 file changed, 66 insertions(+), 6 deletions(-)
diff --git a/packages/pinentry/pinentry.el b/packages/pinentry/pinentry.el
index 7cbe9f5..05cb124 100644
--- a/packages/pinentry/pinentry.el
+++ b/packages/pinentry/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"))
- [elpa] master updated (8d079d3 -> dcc9ba0), Nicolas Petton, 2018/01/16
- [elpa] master adc04d8 03/11: pinentry.el: Support external passphrase cache, Nicolas Petton, 2018/01/16
- [elpa] master efb0175 09/11: Change the default socket location for pinentry, Nicolas Petton, 2018/01/16
- [elpa] master b2dbb4c 10/11: Revert "Change the default socket location for pinentry", Nicolas Petton, 2018/01/16
- [elpa] master 19227a0 02/11: ; pinentry.el: Update header comment and fix typos, Nicolas Petton, 2018/01/16
- [elpa] master 1cfcece 01/11: packages/pinentry/pinentry.el: Popup window for multiline prompt,
Nicolas Petton <=
- [elpa] master 2a2617f 04/11: Revert "pinentry.el: Support external passphrase cache", Nicolas Petton, 2018/01/16
- [elpa] master 32bec2a 06/11: pinentry.el: Add debugging support, Nicolas Petton, 2018/01/16
- [elpa] master 7154adf 05/11: pinentry.el: Improve multiline prompt, Nicolas Petton, 2018/01/16
- [elpa] master cd62826 08/11: Mention how to enable pinentry feature, Nicolas Petton, 2018/01/16
- [elpa] master 952dd9f 07/11: Suppress redundant Pinentry startup messages, Nicolas Petton, 2018/01/16
- [elpa] master dcc9ba0 11/11: Set file modes of pinentry socket for extra safety, Nicolas Petton, 2018/01/16