Mercurial > emacs
comparison lisp/pgg.el @ 86496:e793ef63bdb9
(pgg-clear-string): Declare as a function.
(pgg-run-at-time-1): Wrap whole definition in (featurep 'xemacs) test.
(pgg-run-at-time, pgg-cancel-timer): Move definitions before use.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Tue, 27 Nov 2007 04:20:20 +0000 |
parents | b98604865ea0 |
children | bc4976b7380e |
comparison
equal
deleted
inserted
replaced
86495:65af9ed993be | 86496:e793ef63bdb9 |
---|---|
38 (require 'cl)) | 38 (require 'cl)) |
39 | 39 |
40 ;;; @ utility functions | 40 ;;; @ utility functions |
41 ;;; | 41 ;;; |
42 | 42 |
43 (defun pgg-invoke (func scheme &rest args) | |
44 (progn | |
45 (require (intern (format "pgg-%s" scheme))) | |
46 (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args))) | |
47 | |
48 (put 'pgg-save-coding-system 'lisp-indent-function 2) | |
49 | |
50 (defmacro pgg-save-coding-system (start end &rest body) | |
51 `(if (interactive-p) | |
52 (let ((buffer (current-buffer))) | |
53 (with-temp-buffer | |
54 (let (buffer-undo-list) | |
55 (insert-buffer-substring buffer ,start ,end) | |
56 (encode-coding-region (point-min)(point-max) | |
57 buffer-file-coding-system) | |
58 (prog1 (save-excursion ,@body) | |
59 (push nil buffer-undo-list) | |
60 (ignore-errors (undo)))))) | |
61 (save-restriction | |
62 (narrow-to-region ,start ,end) | |
63 ,@body))) | |
64 | |
65 (defun pgg-temp-buffer-show-function (buffer) | |
66 (let ((window (or (get-buffer-window buffer 'visible) | |
67 (split-window-vertically)))) | |
68 (set-window-buffer window buffer) | |
69 (shrink-window-if-larger-than-buffer window))) | |
70 | |
71 ;; XXX `pgg-display-output-buffer' is a horrible name for this function. | |
72 ;; It should be something like `pgg-situate-output-or-display-error'. | |
73 (defun pgg-display-output-buffer (start end status) | |
74 "Situate en/decryption results or pop up an error buffer. | |
75 | |
76 Text from START to END is replaced by contents of output buffer if STATUS | |
77 is true, or else the output buffer is displayed." | |
78 (if status | |
79 (pgg-situate-output start end) | |
80 (pgg-display-error-buffer))) | |
81 | |
82 (defun pgg-situate-output (start end) | |
83 "Place en/decryption result in place of current text from START to END." | |
84 (delete-region start end) | |
85 (insert-buffer-substring pgg-output-buffer) | |
86 (decode-coding-region start (point) buffer-file-coding-system)) | |
87 | |
88 (defun pgg-display-error-buffer () | |
89 "Pop up an error buffer indicating the reason for an en/decryption failure." | |
90 (let ((temp-buffer-show-function | |
91 (function pgg-temp-buffer-show-function))) | |
92 (with-output-to-temp-buffer pgg-echo-buffer | |
93 (set-buffer standard-output) | |
94 (insert-buffer-substring pgg-errors-buffer)))) | |
95 | |
96 (defvar pgg-passphrase-cache (make-vector 7 0)) | |
97 | |
98 (defvar pgg-pending-timers (make-vector 7 0) | |
99 "Hash table for managing scheduled pgg cache management timers. | |
100 | |
101 We associate key and timer, so the timer can be cancelled if a new | |
102 timeout for the key is set while an old one is still pending.") | |
103 | |
104 (defun pgg-read-passphrase (prompt &optional key notruncate) | |
105 "Using PROMPT, obtain passphrase for KEY from cache or user. | |
106 | |
107 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
108 \(default false). | |
109 | |
110 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
111 regulate cache behavior." | |
112 (or (pgg-read-passphrase-from-cache key notruncate) | |
113 (read-passwd prompt))) | |
114 | |
115 (defun pgg-read-passphrase-from-cache (key &optional notruncate) | |
116 "Obtain passphrase for KEY from time-limited passphrase cache. | |
117 | |
118 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
119 \(default false). | |
120 | |
121 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
122 regulate cache behavior." | |
123 (and pgg-cache-passphrase | |
124 key (or notruncate | |
125 (setq key (pgg-truncate-key-identifier key))) | |
126 (symbol-value (intern-soft key pgg-passphrase-cache)))) | |
127 | |
128 (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate) | |
129 "Associate KEY with PASSPHRASE in time-limited passphrase cache. | |
130 | |
131 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
132 \(default false). | |
133 | |
134 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
135 regulate cache behavior." | |
136 | |
137 (let* ((key (if notruncate key (pgg-truncate-key-identifier key))) | |
138 (interned-timer-key (intern-soft key pgg-pending-timers)) | |
139 (old-timer (symbol-value interned-timer-key)) | |
140 new-timer) | |
141 (when old-timer | |
142 (cancel-timer old-timer) | |
143 (unintern interned-timer-key pgg-pending-timers)) | |
144 (set (intern key pgg-passphrase-cache) | |
145 passphrase) | |
146 (set (intern key pgg-pending-timers) | |
147 (pgg-run-at-time pgg-passphrase-cache-expiry nil | |
148 #'pgg-remove-passphrase-from-cache | |
149 key notruncate)))) | |
150 | |
151 (if (fboundp 'clear-string) | |
152 (defalias 'pgg-clear-string 'clear-string) | |
153 (defun pgg-clear-string (string) | |
154 (fillarray string ?_))) | |
155 | |
156 (defun pgg-remove-passphrase-from-cache (key &optional notruncate) | |
157 "Omit passphrase associated with KEY in time-limited passphrase cache. | |
158 | |
159 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
160 \(default false). | |
161 | |
162 This is a no-op if there is not entry for KEY (eg, it's already expired. | |
163 | |
164 The memory for the passphrase is filled with underscores to clear any | |
165 references to it. | |
166 | |
167 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
168 regulate cache behavior." | |
169 (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate)) | |
170 (key (if notruncate key (pgg-truncate-key-identifier key))) | |
171 (interned-timer-key (intern-soft key pgg-pending-timers)) | |
172 (old-timer (symbol-value interned-timer-key))) | |
173 (when passphrase | |
174 (pgg-clear-string passphrase) | |
175 (unintern key pgg-passphrase-cache)) | |
176 (when old-timer | |
177 (pgg-cancel-timer old-timer) | |
178 (unintern interned-timer-key pgg-pending-timers)))) | |
179 | |
180 (eval-when-compile | 43 (eval-when-compile |
181 (defmacro pgg-run-at-time-1 (time repeat function args) | 44 (unless (featurep 'xemacs) |
182 (when (featurep 'xemacs) | 45 (defalias 'pgg-run-at-time 'run-at-time) |
46 (defalias 'pgg-cancel-timer 'cancel-timer)) | |
47 | |
48 (when (featurep 'xemacs) | |
49 (defmacro pgg-run-at-time-1 (time repeat function args) | |
183 (if (condition-case nil | 50 (if (condition-case nil |
184 (let ((delete-itimer 'delete-itimer) | 51 (let ((delete-itimer 'delete-itimer) |
185 (itimer-driver-start 'itimer-driver-start) | 52 (itimer-driver-start 'itimer-driver-start) |
186 (itimer-value 'itimer-value) | 53 (itimer-value 'itimer-value) |
187 (start-itimer 'start-itimer)) | 54 (start-itimer 'start-itimer)) |
235 (apply function args))) | 102 (apply function args))) |
236 (set-itimer-function-arguments | 103 (set-itimer-function-arguments |
237 itimer | 104 itimer |
238 (append (list itimer function) args))))) | 105 (append (list itimer function) args))))) |
239 1e-9 (if time (max time 1e-9) 1e-9) | 106 1e-9 (if time (max time 1e-9) 1e-9) |
240 nil t itimers ,repeat ,function ,args)))))) | 107 nil t itimers ,repeat ,function ,args)))) |
241 | 108 |
242 (eval-and-compile | 109 (defun pgg-run-at-time (time repeat function &rest args) |
243 (if (featurep 'xemacs) | 110 "Emulating function run as `run-at-time'. |
244 (progn | |
245 (defun pgg-run-at-time (time repeat function &rest args) | |
246 "Emulating function run as `run-at-time'. | |
247 TIME should be nil meaning now, or a number of seconds from now. | 111 TIME should be nil meaning now, or a number of seconds from now. |
248 Return an itimer object which can be used in either `delete-itimer' | 112 Return an itimer object which can be used in either `delete-itimer' |
249 or `cancel-timer'." | 113 or `cancel-timer'." |
250 (pgg-run-at-time-1 time repeat function args)) | 114 (pgg-run-at-time-1 time repeat function args)) |
251 (defun pgg-cancel-timer (timer) | 115 (defun pgg-cancel-timer (timer) |
252 "Emulate cancel-timer for xemacs." | 116 "Emulate cancel-timer for xemacs." |
253 (let ((delete-itimer 'delete-itimer)) | 117 (let ((delete-itimer 'delete-itimer)) |
254 (funcall delete-itimer timer))) | 118 (funcall delete-itimer timer))) |
255 ) | 119 )) |
256 (defalias 'pgg-run-at-time 'run-at-time) | 120 |
257 (defalias 'pgg-cancel-timer 'cancel-timer))) | 121 (defun pgg-invoke (func scheme &rest args) |
122 (progn | |
123 (require (intern (format "pgg-%s" scheme))) | |
124 (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args))) | |
125 | |
126 (put 'pgg-save-coding-system 'lisp-indent-function 2) | |
127 | |
128 (defmacro pgg-save-coding-system (start end &rest body) | |
129 `(if (interactive-p) | |
130 (let ((buffer (current-buffer))) | |
131 (with-temp-buffer | |
132 (let (buffer-undo-list) | |
133 (insert-buffer-substring buffer ,start ,end) | |
134 (encode-coding-region (point-min)(point-max) | |
135 buffer-file-coding-system) | |
136 (prog1 (save-excursion ,@body) | |
137 (push nil buffer-undo-list) | |
138 (ignore-errors (undo)))))) | |
139 (save-restriction | |
140 (narrow-to-region ,start ,end) | |
141 ,@body))) | |
142 | |
143 (defun pgg-temp-buffer-show-function (buffer) | |
144 (let ((window (or (get-buffer-window buffer 'visible) | |
145 (split-window-vertically)))) | |
146 (set-window-buffer window buffer) | |
147 (shrink-window-if-larger-than-buffer window))) | |
148 | |
149 ;; XXX `pgg-display-output-buffer' is a horrible name for this function. | |
150 ;; It should be something like `pgg-situate-output-or-display-error'. | |
151 (defun pgg-display-output-buffer (start end status) | |
152 "Situate en/decryption results or pop up an error buffer. | |
153 | |
154 Text from START to END is replaced by contents of output buffer if STATUS | |
155 is true, or else the output buffer is displayed." | |
156 (if status | |
157 (pgg-situate-output start end) | |
158 (pgg-display-error-buffer))) | |
159 | |
160 (defun pgg-situate-output (start end) | |
161 "Place en/decryption result in place of current text from START to END." | |
162 (delete-region start end) | |
163 (insert-buffer-substring pgg-output-buffer) | |
164 (decode-coding-region start (point) buffer-file-coding-system)) | |
165 | |
166 (defun pgg-display-error-buffer () | |
167 "Pop up an error buffer indicating the reason for an en/decryption failure." | |
168 (let ((temp-buffer-show-function | |
169 (function pgg-temp-buffer-show-function))) | |
170 (with-output-to-temp-buffer pgg-echo-buffer | |
171 (set-buffer standard-output) | |
172 (insert-buffer-substring pgg-errors-buffer)))) | |
173 | |
174 (defvar pgg-passphrase-cache (make-vector 7 0)) | |
175 | |
176 (defvar pgg-pending-timers (make-vector 7 0) | |
177 "Hash table for managing scheduled pgg cache management timers. | |
178 | |
179 We associate key and timer, so the timer can be cancelled if a new | |
180 timeout for the key is set while an old one is still pending.") | |
181 | |
182 (defun pgg-read-passphrase (prompt &optional key notruncate) | |
183 "Using PROMPT, obtain passphrase for KEY from cache or user. | |
184 | |
185 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
186 \(default false). | |
187 | |
188 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
189 regulate cache behavior." | |
190 (or (pgg-read-passphrase-from-cache key notruncate) | |
191 (read-passwd prompt))) | |
192 | |
193 (defun pgg-read-passphrase-from-cache (key &optional notruncate) | |
194 "Obtain passphrase for KEY from time-limited passphrase cache. | |
195 | |
196 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
197 \(default false). | |
198 | |
199 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
200 regulate cache behavior." | |
201 (and pgg-cache-passphrase | |
202 key (or notruncate | |
203 (setq key (pgg-truncate-key-identifier key))) | |
204 (symbol-value (intern-soft key pgg-passphrase-cache)))) | |
205 | |
206 (defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate) | |
207 "Associate KEY with PASSPHRASE in time-limited passphrase cache. | |
208 | |
209 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
210 \(default false). | |
211 | |
212 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
213 regulate cache behavior." | |
214 | |
215 (let* ((key (if notruncate key (pgg-truncate-key-identifier key))) | |
216 (interned-timer-key (intern-soft key pgg-pending-timers)) | |
217 (old-timer (symbol-value interned-timer-key)) | |
218 new-timer) | |
219 (when old-timer | |
220 (cancel-timer old-timer) | |
221 (unintern interned-timer-key pgg-pending-timers)) | |
222 (set (intern key pgg-passphrase-cache) | |
223 passphrase) | |
224 (set (intern key pgg-pending-timers) | |
225 (pgg-run-at-time pgg-passphrase-cache-expiry nil | |
226 #'pgg-remove-passphrase-from-cache | |
227 key notruncate)))) | |
228 | |
229 (if (fboundp 'clear-string) | |
230 (defalias 'pgg-clear-string 'clear-string) | |
231 (defun pgg-clear-string (string) | |
232 (fillarray string ?_))) | |
233 | |
234 (declare-function pgg-clear-string "pgg" (string)) | |
235 | |
236 (defun pgg-remove-passphrase-from-cache (key &optional notruncate) | |
237 "Omit passphrase associated with KEY in time-limited passphrase cache. | |
238 | |
239 Truncate the key to 8 trailing characters unless NOTRUNCATE is true | |
240 \(default false). | |
241 | |
242 This is a no-op if there is not entry for KEY (eg, it's already expired. | |
243 | |
244 The memory for the passphrase is filled with underscores to clear any | |
245 references to it. | |
246 | |
247 Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' | |
248 regulate cache behavior." | |
249 (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate)) | |
250 (key (if notruncate key (pgg-truncate-key-identifier key))) | |
251 (interned-timer-key (intern-soft key pgg-pending-timers)) | |
252 (old-timer (symbol-value interned-timer-key))) | |
253 (when passphrase | |
254 (pgg-clear-string passphrase) | |
255 (unintern key pgg-passphrase-cache)) | |
256 (when old-timer | |
257 (pgg-cancel-timer old-timer) | |
258 (unintern interned-timer-key pgg-pending-timers)))) | |
258 | 259 |
259 (defmacro pgg-convert-lbt-region (start end lbt) | 260 (defmacro pgg-convert-lbt-region (start end lbt) |
260 `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) | 261 `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) |
261 (goto-char ,start) | 262 (goto-char ,start) |
262 (case ,lbt | 263 (case ,lbt |