Commit | Line | Data |
---|---|---|
3556c249 | 1 | ;;; plstore.el --- secure plist store -*- lexical-binding: t -*- |
acaf905b | 2 | ;; Copyright (C) 2011-2012 Free Software Foundation, Inc. |
8977de27 DU |
3 | |
4 | ;; Author: Daiki Ueno <ueno@unixuser.org> | |
5 | ;; Keywords: PGP, GnuPG | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary | |
23 | ||
3556c249 DU |
24 | ;; Plist based data store providing search and partial encryption. |
25 | ;; | |
8977de27 DU |
26 | ;; Creating: |
27 | ;; | |
3556c249 | 28 | ;; ;; Open a new store associated with ~/.emacs.d/auth.plist. |
8977de27 | 29 | ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist"))) |
3556c249 | 30 | ;; ;; Both `:host' and `:port' are public property. |
8977de27 | 31 | ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil) |
3556c249 | 32 | ;; ;; No encryption will be needed. |
8977de27 | 33 | ;; (plstore-save store) |
3556c249 DU |
34 | ;; |
35 | ;; ;; `:user' is marked as secret. | |
8977de27 | 36 | ;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test")) |
3556c249 DU |
37 | ;; ;; `:password' is marked as secret. |
38 | ;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test")) | |
39 | ;; ;; Those secret properties are encrypted together. | |
40 | ;; (plstore-save store) | |
41 | ;; | |
42 | ;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist. | |
8977de27 DU |
43 | ;; (plstore-close store) |
44 | ;; | |
45 | ;; Searching: | |
46 | ;; | |
47 | ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist"))) | |
3556c249 DU |
48 | ;; |
49 | ;; ;; As the entry "foo" associated with "foo.example.org" has no | |
50 | ;; ;; secret properties, no need to decryption. | |
8977de27 | 51 | ;; (plstore-find store '(:host ("foo.example.org"))) |
3556c249 DU |
52 | ;; |
53 | ;; ;; As the entry "bar" associated with "bar.example.org" has a | |
54 | ;; ;; secret property `:user', Emacs tries to decrypt the secret (and | |
55 | ;; ;; thus you will need to input passphrase). | |
56 | ;; (plstore-find store '(:host ("bar.example.org"))) | |
57 | ;; | |
58 | ;; ;; While the entry "baz" associated with "baz.example.org" has also | |
59 | ;; ;; a secret property `:password', it is encrypted together with | |
60 | ;; ;; `:user' of "bar", so no need to decrypt the secret. | |
61 | ;; (plstore-find store '(:host ("bar.example.org"))) | |
62 | ;; | |
8977de27 DU |
63 | ;; (plstore-close store) |
64 | ;; | |
3556c249 DU |
65 | ;; Editing: |
66 | ;; | |
823ad1d7 DU |
67 | ;; This file also provides `plstore-mode', a major mode for editing |
68 | ;; the PLSTORE format file. Visit a non-existing file and put the | |
69 | ;; following line: | |
70 | ;; | |
71 | ;; (("foo" :host "foo.example.org" :secret-user "user")) | |
72 | ;; | |
73 | ;; where the prefixing `:secret-' means the property (without | |
74 | ;; `:secret-' prefix) is marked as secret. Thus, when you save the | |
75 | ;; buffer, the `:secret-user' property is encrypted as `:user'. | |
76 | ;; | |
77 | ;; You can toggle the view between encrypted form and the decrypted | |
78 | ;; form with C-c C-c. | |
8977de27 DU |
79 | |
80 | ;;; Code: | |
81 | ||
82 | (require 'epg) | |
83 | ||
cdf4d455 DU |
84 | (defgroup plstore nil |
85 | "Searchable, partially encrypted, persistent plist store" | |
86 | :version "24.1" | |
87 | :group 'files) | |
88 | ||
89 | (defcustom plstore-select-keys 'silent | |
90 | "Control whether or not to pop up the key selection dialog. | |
91 | ||
92 | If t, always asks user to select recipients. | |
90926e23 DU |
93 | If nil, query user only when a file's default recipients are not |
94 | known (i.e. `plstore-encrypt-to' is not locally set in the buffer | |
95 | visiting a plstore file). | |
96 | If neither t nor nil, doesn't ask user." | |
cdf4d455 DU |
97 | :type '(choice (const :tag "Ask always" t) |
98 | (const :tag "Ask when recipients are not set" nil) | |
99 | (const :tag "Don't ask" silent)) | |
100 | :group 'plstore) | |
101 | ||
102 | (defvar plstore-encrypt-to nil | |
103 | "*Recipient(s) used for encrypting secret entries. | |
90926e23 DU |
104 | May either be a string or a list of strings. If it is nil, |
105 | symmetric encryption will be used.") | |
cdf4d455 DU |
106 | |
107 | (put 'plstore-encrypt-to 'safe-local-variable | |
108 | (lambda (val) | |
109 | (or (stringp val) | |
110 | (and (listp val) | |
111 | (catch 'safe | |
112 | (mapc (lambda (elt) | |
113 | (unless (stringp elt) | |
114 | (throw 'safe nil))) | |
115 | val) | |
116 | t))))) | |
117 | ||
118 | (put 'plstore-encrypt-to 'permanent-local t) | |
119 | ||
823ad1d7 DU |
120 | (defvar plstore-encoded nil) |
121 | ||
122 | (put 'plstore-encoded 'permanent-local t) | |
123 | ||
8977de27 DU |
124 | (defvar plstore-cache-passphrase-for-symmetric-encryption nil) |
125 | (defvar plstore-passphrase-alist nil) | |
126 | ||
127 | (defun plstore-passphrase-callback-function (_context _key-id plstore) | |
128 | (if plstore-cache-passphrase-for-symmetric-encryption | |
129 | (let* ((file (file-truename (plstore--get-buffer plstore))) | |
130 | (entry (assoc file plstore-passphrase-alist)) | |
131 | passphrase) | |
132 | (or (copy-sequence (cdr entry)) | |
133 | (progn | |
134 | (unless entry | |
135 | (setq entry (list file) | |
136 | plstore-passphrase-alist | |
137 | (cons entry | |
138 | plstore-passphrase-alist))) | |
139 | (setq passphrase | |
140 | (read-passwd (format "Passphrase for PLSTORE %s: " | |
141 | (plstore--get-buffer plstore)))) | |
142 | (setcdr entry (copy-sequence passphrase)) | |
143 | passphrase))) | |
144 | (read-passwd (format "Passphrase for PLSTORE %s: " | |
145 | (plstore--get-buffer plstore))))) | |
146 | ||
147 | (defun plstore-progress-callback-function (_context _what _char current total | |
148 | handback) | |
149 | (if (= current total) | |
150 | (message "%s...done" handback) | |
151 | (message "%s...%d%%" handback | |
152 | (if (> total 0) (floor (* (/ current (float total)) 100)) 0)))) | |
153 | ||
e21bac42 G |
154 | (defun plstore--get-buffer (arg) |
155 | (aref arg 0)) | |
8977de27 | 156 | |
e21bac42 G |
157 | (defun plstore--get-alist (arg) |
158 | (aref arg 1)) | |
8977de27 | 159 | |
e21bac42 G |
160 | (defun plstore--get-encrypted-data (arg) |
161 | (aref arg 2)) | |
8977de27 | 162 | |
e21bac42 G |
163 | (defun plstore--get-secret-alist (arg) |
164 | (aref arg 3)) | |
8977de27 | 165 | |
e21bac42 G |
166 | (defun plstore--get-merged-alist (arg) |
167 | (aref arg 4)) | |
8977de27 | 168 | |
e21bac42 G |
169 | (defun plstore--set-buffer (arg buffer) |
170 | (aset arg 0 buffer)) | |
8977de27 | 171 | |
e21bac42 G |
172 | (defun plstore--set-alist (arg plist) |
173 | (aset arg 1 plist)) | |
8977de27 | 174 | |
e21bac42 G |
175 | (defun plstore--set-encrypted-data (arg encrypted-data) |
176 | (aset arg 2 encrypted-data)) | |
8977de27 | 177 | |
e21bac42 G |
178 | (defun plstore--set-secret-alist (arg secret-alist) |
179 | (aset arg 3 secret-alist)) | |
8977de27 | 180 | |
e21bac42 G |
181 | (defun plstore--set-merged-alist (arg merged-alist) |
182 | (aset arg 4 merged-alist)) | |
8977de27 | 183 | |
e21bac42 G |
184 | (defun plstore-get-file (arg) |
185 | (buffer-file-name (plstore--get-buffer arg))) | |
8977de27 | 186 | |
3556c249 DU |
187 | (defun plstore--make (&optional buffer alist encrypted-data secret-alist |
188 | merged-alist) | |
189 | (vector buffer alist encrypted-data secret-alist merged-alist)) | |
190 | ||
cdf4d455 DU |
191 | (defun plstore--init-from-buffer (plstore) |
192 | (goto-char (point-min)) | |
3e0b797f | 193 | (when (looking-at ";;; public entries") |
cdf4d455 DU |
194 | (forward-line) |
195 | (plstore--set-alist plstore (read (point-marker))) | |
196 | (forward-sexp) | |
197 | (forward-char) | |
3e0b797f | 198 | (when (looking-at ";;; secret entries") |
cdf4d455 DU |
199 | (forward-line) |
200 | (plstore--set-encrypted-data plstore (read (point-marker)))) | |
201 | (plstore--merge-secret plstore))) | |
202 | ||
8977de27 DU |
203 | ;;;###autoload |
204 | (defun plstore-open (file) | |
205 | "Create a plstore instance associated with FILE." | |
3556c249 DU |
206 | (let* ((filename (file-truename file)) |
207 | (buffer (or (find-buffer-visiting filename) | |
208 | (generate-new-buffer (format " plstore %s" filename)))) | |
209 | (store (plstore--make buffer))) | |
210 | (with-current-buffer buffer | |
211 | (erase-buffer) | |
212 | (condition-case nil | |
213 | (insert-file-contents-literally file) | |
214 | (error)) | |
215 | (setq buffer-file-name (file-truename file)) | |
216 | (set-buffer-modified-p nil) | |
cdf4d455 DU |
217 | (plstore--init-from-buffer store) |
218 | store))) | |
8977de27 | 219 | |
8a8cdb19 DU |
220 | (defun plstore-revert (plstore) |
221 | "Replace current data in PLSTORE with the file on disk." | |
222 | (with-current-buffer (plstore--get-buffer plstore) | |
f11f303b | 223 | (revert-buffer t t) |
cdf4d455 | 224 | (plstore--init-from-buffer plstore))) |
8a8cdb19 | 225 | |
8977de27 DU |
226 | (defun plstore-close (plstore) |
227 | "Destroy a plstore instance PLSTORE." | |
228 | (kill-buffer (plstore--get-buffer plstore))) | |
229 | ||
230 | (defun plstore--merge-secret (plstore) | |
231 | (let ((alist (plstore--get-secret-alist plstore)) | |
232 | modified-alist | |
233 | modified-plist | |
234 | modified-entry | |
235 | entry | |
236 | plist | |
237 | placeholder) | |
238 | (plstore--set-merged-alist | |
239 | plstore | |
240 | (copy-tree (plstore--get-alist plstore))) | |
241 | (setq modified-alist (plstore--get-merged-alist plstore)) | |
242 | (while alist | |
243 | (setq entry (car alist) | |
244 | alist (cdr alist) | |
245 | plist (cdr entry) | |
246 | modified-entry (assoc (car entry) modified-alist) | |
247 | modified-plist (cdr modified-entry)) | |
248 | (while plist | |
249 | (setq placeholder | |
250 | (plist-member | |
251 | modified-plist | |
252 | (intern (concat ":secret-" | |
253 | (substring (symbol-name (car plist)) 1))))) | |
254 | (if placeholder | |
255 | (setcar placeholder (car plist))) | |
256 | (setq modified-plist | |
257 | (plist-put modified-plist (car plist) (car (cdr plist)))) | |
258 | (setq plist (nthcdr 2 plist))) | |
259 | (setcdr modified-entry modified-plist)))) | |
260 | ||
261 | (defun plstore--decrypt (plstore) | |
262 | (if (plstore--get-encrypted-data plstore) | |
263 | (let ((context (epg-make-context 'OpenPGP)) | |
264 | plain) | |
265 | (epg-context-set-passphrase-callback | |
266 | context | |
267 | (cons #'plstore-passphrase-callback-function | |
268 | plstore)) | |
269 | (epg-context-set-progress-callback | |
270 | context | |
271 | (cons #'plstore-progress-callback-function | |
272 | (format "Decrypting %s" (plstore-get-file plstore)))) | |
273 | (setq plain | |
274 | (epg-decrypt-string context | |
275 | (plstore--get-encrypted-data plstore))) | |
276 | (plstore--set-secret-alist plstore (car (read-from-string plain))) | |
277 | (plstore--merge-secret plstore) | |
278 | (plstore--set-encrypted-data plstore nil)))) | |
279 | ||
280 | (defun plstore--match (entry keys skip-if-secret-found) | |
281 | (let ((result t) key-name key-value prop-value secret-name) | |
282 | (while keys | |
283 | (setq key-name (car keys) | |
284 | key-value (car (cdr keys)) | |
285 | prop-value (plist-get (cdr entry) key-name)) | |
286 | (unless (member prop-value key-value) | |
287 | (if skip-if-secret-found | |
288 | (progn | |
289 | (setq secret-name | |
290 | (intern (concat ":secret-" | |
291 | (substring (symbol-name key-name) 1)))) | |
292 | (if (plist-member (cdr entry) secret-name) | |
293 | (setq result 'secret) | |
294 | (setq result nil | |
295 | keys nil))) | |
296 | (setq result nil | |
297 | keys nil))) | |
298 | (setq keys (nthcdr 2 keys))) | |
299 | result)) | |
300 | ||
301 | (defun plstore-find (plstore keys) | |
302 | "Perform search on PLSTORE with KEYS. | |
303 | KEYS is a plist." | |
304 | (let (entries alist entry match decrypt plist) | |
305 | ;; First, go through the merged plist alist and collect entries | |
306 | ;; matched with keys. | |
307 | (setq alist (plstore--get-merged-alist plstore)) | |
308 | (while alist | |
309 | (setq entry (car alist) | |
310 | alist (cdr alist) | |
311 | match (plstore--match entry keys t)) | |
312 | (if (eq match 'secret) | |
313 | (setq decrypt t) | |
314 | (when match | |
315 | (setq plist (cdr entry)) | |
316 | (while plist | |
317 | (if (string-match "\\`:secret-" (symbol-name (car plist))) | |
318 | (setq decrypt t | |
319 | plist nil)) | |
320 | (setq plist (nthcdr 2 plist))) | |
321 | (setq entries (cons entry entries))))) | |
322 | ;; Second, decrypt the encrypted plist and try again. | |
323 | (when decrypt | |
324 | (setq entries nil) | |
325 | (plstore--decrypt plstore) | |
326 | (setq alist (plstore--get-merged-alist plstore)) | |
327 | (while alist | |
328 | (setq entry (car alist) | |
329 | alist (cdr alist) | |
330 | match (plstore--match entry keys nil)) | |
331 | (if match | |
332 | (setq entries (cons entry entries))))) | |
333 | (nreverse entries))) | |
334 | ||
335 | (defun plstore-get (plstore name) | |
336 | "Get an entry with NAME in PLSTORE." | |
337 | (let ((entry (assoc name (plstore--get-merged-alist plstore))) | |
338 | plist) | |
339 | (setq plist (cdr entry)) | |
340 | (while plist | |
341 | (if (string-match "\\`:secret-" (symbol-name (car plist))) | |
342 | (progn | |
343 | (plstore--decrypt plstore) | |
344 | (setq entry (assoc name (plstore--get-merged-alist plstore)) | |
345 | plist nil)) | |
346 | (setq plist (nthcdr 2 plist)))) | |
347 | entry)) | |
348 | ||
349 | (defun plstore-put (plstore name keys secret-keys) | |
350 | "Put an entry with NAME in PLSTORE. | |
351 | KEYS is a plist containing non-secret data. | |
352 | SECRET-KEYS is a plist containing secret data." | |
353 | (let (entry | |
354 | plist | |
355 | secret-plist | |
356 | symbol) | |
357 | (if secret-keys | |
358 | (plstore--decrypt plstore)) | |
359 | (while secret-keys | |
360 | (setq symbol | |
361 | (intern (concat ":secret-" | |
362 | (substring (symbol-name (car secret-keys)) 1)))) | |
363 | (setq plist (plist-put plist symbol t) | |
364 | secret-plist (plist-put secret-plist | |
365 | (car secret-keys) (car (cdr secret-keys))) | |
366 | secret-keys (nthcdr 2 secret-keys))) | |
367 | (while keys | |
368 | (setq symbol | |
369 | (intern (concat ":secret-" | |
370 | (substring (symbol-name (car keys)) 1)))) | |
371 | (setq plist (plist-put plist (car keys) (car (cdr keys))) | |
372 | keys (nthcdr 2 keys))) | |
373 | (setq entry (assoc name (plstore--get-alist plstore))) | |
374 | (if entry | |
375 | (setcdr entry plist) | |
376 | (plstore--set-alist | |
377 | plstore | |
378 | (cons (cons name plist) (plstore--get-alist plstore)))) | |
379 | (when secret-plist | |
380 | (setq entry (assoc name (plstore--get-secret-alist plstore))) | |
381 | (if entry | |
382 | (setcdr entry secret-plist) | |
383 | (plstore--set-secret-alist | |
384 | plstore | |
385 | (cons (cons name secret-plist) (plstore--get-secret-alist plstore))))) | |
386 | (plstore--merge-secret plstore))) | |
387 | ||
f3078a00 DU |
388 | (defun plstore-delete (plstore name) |
389 | "Delete an entry with NAME from PLSTORE." | |
390 | (let ((entry (assoc name (plstore--get-alist plstore)))) | |
391 | (if entry | |
392 | (plstore--set-alist | |
393 | plstore | |
394 | (delq entry (plstore--get-alist plstore)))) | |
395 | (setq entry (assoc name (plstore--get-secret-alist plstore))) | |
396 | (if entry | |
397 | (plstore--set-secret-alist | |
398 | plstore | |
399 | (delq entry (plstore--get-secret-alist plstore)))) | |
400 | (setq entry (assoc name (plstore--get-merged-alist plstore))) | |
401 | (if entry | |
402 | (plstore--set-merged-alist | |
403 | plstore | |
404 | (delq entry (plstore--get-merged-alist plstore)))))) | |
405 | ||
8977de27 | 406 | (defvar pp-escape-newlines) |
3556c249 DU |
407 | (defun plstore--insert-buffer (plstore) |
408 | (insert ";;; public entries -*- mode: plstore -*- \n" | |
409 | (pp-to-string (plstore--get-alist plstore))) | |
410 | (if (plstore--get-secret-alist plstore) | |
411 | (let ((context (epg-make-context 'OpenPGP)) | |
412 | (pp-escape-newlines nil) | |
413 | (recipients | |
414 | (cond | |
415 | ((listp plstore-encrypt-to) plstore-encrypt-to) | |
416 | ((stringp plstore-encrypt-to) (list plstore-encrypt-to)))) | |
417 | cipher) | |
418 | (epg-context-set-armor context t) | |
419 | (epg-context-set-passphrase-callback | |
420 | context | |
421 | (cons #'plstore-passphrase-callback-function | |
422 | plstore)) | |
423 | (setq cipher (epg-encrypt-string | |
424 | context | |
425 | (pp-to-string | |
426 | (plstore--get-secret-alist plstore)) | |
427 | (if (or (eq plstore-select-keys t) | |
428 | (and (null plstore-select-keys) | |
429 | (not (local-variable-p 'plstore-encrypt-to | |
430 | (current-buffer))))) | |
431 | (epa-select-keys | |
432 | context | |
333f9019 | 433 | "Select recipients for encryption. |
3556c249 DU |
434 | If no one is selected, symmetric encryption will be performed. " |
435 | recipients) | |
436 | (if plstore-encrypt-to | |
437 | (epg-list-keys context recipients))))) | |
438 | (goto-char (point-max)) | |
439 | (insert ";;; secret entries\n" (pp-to-string cipher))))) | |
440 | ||
8977de27 DU |
441 | (defun plstore-save (plstore) |
442 | "Save the contents of PLSTORE associated with a FILE." | |
443 | (with-current-buffer (plstore--get-buffer plstore) | |
444 | (erase-buffer) | |
3556c249 | 445 | (plstore--insert-buffer plstore) |
8977de27 DU |
446 | (save-buffer))) |
447 | ||
823ad1d7 DU |
448 | (defun plstore--encode (plstore) |
449 | (plstore--decrypt plstore) | |
450 | (let ((merged-alist (plstore--get-merged-alist plstore))) | |
451 | (concat "(" | |
452 | (mapconcat | |
453 | (lambda (entry) | |
454 | (setq entry (copy-sequence entry)) | |
455 | (let ((merged-plist (cdr (assoc (car entry) merged-alist))) | |
456 | (plist (cdr entry))) | |
457 | (while plist | |
458 | (if (string-match "\\`:secret-" (symbol-name (car plist))) | |
459 | (setcar (cdr plist) | |
460 | (plist-get | |
461 | merged-plist | |
462 | (intern (concat ":" | |
463 | (substring (symbol-name | |
464 | (car plist)) | |
465 | (match-end 0))))))) | |
466 | (setq plist (nthcdr 2 plist))) | |
467 | (prin1-to-string entry))) | |
468 | (plstore--get-alist plstore) | |
469 | "\n") | |
470 | ")"))) | |
471 | ||
472 | (defun plstore--decode (string) | |
473 | (let* ((alist (car (read-from-string string))) | |
474 | (pointer alist) | |
475 | secret-alist | |
476 | plist | |
477 | entry) | |
478 | (while pointer | |
479 | (unless (stringp (car (car pointer))) | |
480 | (error "Invalid PLSTORE format %s" string)) | |
481 | (setq plist (cdr (car pointer))) | |
482 | (while plist | |
483 | (when (string-match "\\`:secret-" (symbol-name (car plist))) | |
484 | (setq entry (assoc (car (car pointer)) secret-alist)) | |
485 | (unless entry | |
486 | (setq entry (list (car (car pointer))) | |
487 | secret-alist (cons entry secret-alist))) | |
488 | (setcdr entry (plist-put (cdr entry) | |
489 | (intern (concat ":" | |
490 | (substring (symbol-name | |
491 | (car plist)) | |
492 | (match-end 0)))) | |
493 | (car (cdr plist)))) | |
494 | (setcar (cdr plist) t)) | |
495 | (setq plist (nthcdr 2 plist))) | |
496 | (setq pointer (cdr pointer))) | |
497 | (plstore--make nil alist nil secret-alist))) | |
498 | ||
499 | (defun plstore--write-contents-functions () | |
500 | (when plstore-encoded | |
501 | (let ((store (plstore--decode (buffer-string))) | |
502 | (file (buffer-file-name))) | |
503 | (unwind-protect | |
504 | (progn | |
505 | (set-visited-file-name nil) | |
506 | (with-temp-buffer | |
507 | (plstore--insert-buffer store) | |
508 | (write-region (buffer-string) nil file))) | |
509 | (set-visited-file-name file) | |
510 | (set-buffer-modified-p nil)) | |
511 | t))) | |
512 | ||
513 | (defun plstore-mode-original () | |
514 | "Show the original form of the this buffer." | |
515 | (interactive) | |
516 | (when plstore-encoded | |
517 | (if (and (buffer-modified-p) | |
518 | (y-or-n-p "Save buffer before reading the original form? ")) | |
519 | (save-buffer)) | |
520 | (erase-buffer) | |
521 | (insert-file-contents-literally (buffer-file-name)) | |
522 | (set-buffer-modified-p nil) | |
523 | (setq plstore-encoded nil))) | |
524 | ||
525 | (defun plstore-mode-decoded () | |
526 | "Show the decoded form of the this buffer." | |
527 | (interactive) | |
528 | (unless plstore-encoded | |
529 | (if (and (buffer-modified-p) | |
530 | (y-or-n-p "Save buffer before decoding? ")) | |
531 | (save-buffer)) | |
532 | (let ((store (plstore--make (current-buffer)))) | |
533 | (plstore--init-from-buffer store) | |
534 | (erase-buffer) | |
535 | (insert | |
536 | (substitute-command-keys "\ | |
537 | ;;; You are looking at the decoded form of the PLSTORE file.\n\ | |
538 | ;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n")) | |
539 | (insert (plstore--encode store)) | |
540 | (set-buffer-modified-p nil) | |
541 | (setq plstore-encoded t)))) | |
542 | ||
543 | (defun plstore-mode-toggle-display () | |
544 | "Toggle the display mode of PLSTORE between the original and decoded forms." | |
545 | (interactive) | |
546 | (if plstore-encoded | |
547 | (plstore-mode-original) | |
548 | (plstore-mode-decoded))) | |
549 | ||
36d55cd4 DU |
550 | (eval-when-compile |
551 | (defmacro plstore-called-interactively-p (kind) | |
552 | (condition-case nil | |
553 | (progn | |
554 | (eval '(called-interactively-p 'any)) | |
555 | ;; Emacs >=23.2 | |
556 | `(called-interactively-p ,kind)) | |
557 | ;; Emacs <23.2 | |
558 | (wrong-number-of-arguments '(called-interactively-p)) | |
559 | ;; XEmacs | |
560 | (void-function '(interactive-p))))) | |
561 | ||
823ad1d7 DU |
562 | ;;;###autoload |
563 | (define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE" | |
564 | "Major mode for editing PLSTORE files." | |
565 | (make-local-variable 'plstore-encoded) | |
566 | (add-hook 'write-contents-functions #'plstore--write-contents-functions) | |
567 | (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display) | |
568 | ;; to create a new file with plstore-mode, mark it as already decoded | |
36d55cd4 | 569 | (if (plstore-called-interactively-p 'any) |
823ad1d7 DU |
570 | (setq plstore-encoded t) |
571 | (plstore-mode-decoded))) | |
572 | ||
8977de27 DU |
573 | (provide 'plstore) |
574 | ||
575 | ;;; plstore.el ends here |