Annotation of pgp/contrib/emacs/pgp.el1, revision 1.1.1.1

1.1       root        1: To: [email protected] (Derek Atkins)
                      2: In-reply-to: [email protected]'s message of 1 Mar 1993 03:59:41 GMT
                      3: Subject: Request for Mailer Scripts
                      4: BCC: jtkohl
                      5: Full-name: John T Kohl
                      6: X-US-Snail: DEC, 110 Spit Brook Road, M/S ZKO3-3/U14, Nashua, NH  03062
                      7: --text follows this line--
                      8: here's some elisp I got from Bill Sommerfeld, and hacked up a bit
                      9: myself:
                     10: ;;;
                     11: ;;; wrapper for the "Pretty-Good-Privacy" program.
                     12: ;;;
                     13: 
                     14: (defvar pgp-program (expand-file-name "/usr/local/bin/pgp") 
                     15:   "*Name of the PGP executable")
                     16: (defvar pgp-sender-name "jtkohl@zk3"
                     17:   "*Name of secret key to use for signing/encrypting messages with PGP")
                     18: 
                     19: (require 'rmail)
                     20: (require 'terminal)
                     21: (require 'backquote)
                     22: 
                     23: (defvar pgp-encrypt-mail t)
                     24: (defvar pgp-sign-mail t)
                     25: (defvar pgp-output-mode-map nil
                     26:   "Keymap used in PGP Output mode")
                     27: 
                     28: (defvar pgp-finished)
                     29: (make-variable-buffer-local 'pgp-finished)
                     30: (set-default 'pgp-finished nil)
                     31: (defvar termhook-finished)
                     32: (make-variable-buffer-local 'termhook-finished)
                     33: (set-default 'termhook-finished nil)
                     34: 
                     35: (defun pgp-output-quit ()
                     36:   (interactive)
                     37:   (let ((buffer (current-buffer)))
                     38:     (switch-to-buffer
                     39:      (if (and (boundp 'pgp-prev-buffer) (bufferp pgp-prev-buffer))
                     40:         pgp-prev-buffer
                     41:        (other-buffer buffer)))
                     42:     (bury-buffer buffer)))
                     43: 
                     44: (defun pgp-keymap-init ()
                     45:   (setq pgp-output-mode-map (make-keymap))
                     46:   (suppress-keymap pgp-output-mode-map)
                     47:   (define-key pgp-output-mode-map " " 'scroll-up)
                     48:   (define-key pgp-output-mode-map "\177" 'scroll-down)
                     49:   (define-key pgp-output-mode-map "q" 'pgp-output-quit))
                     50: 
                     51: (if (not pgp-output-mode-map)
                     52:   (pgp-keymap-init))
                     53: 
                     54: (defun pgp-output-mode ()
                     55:   (interactive)
                     56:   (fundamental-mode)
                     57:   (setq mode-name "PGP-Output")
                     58:   (setq major-mode 'pgp-output-mode)
                     59:   (setq buffer-read-only t)
                     60:   (setq buffer-auto-save-file-name nil)
                     61:   (use-local-map pgp-output-mode-map))
                     62: 
                     63: 
                     64: ;; a "continuation".. what we do after pgp is done..
                     65: ;; this could set the current buffer (the terminal emulator one) 
                     66: ;; into a new major mode (pgp-after-mode) to let you do things like:
                     67: ;;  a) easily dismiss the pgp window
                     68: ;;  b) view any output files.
                     69: ;;  c) see what the "labelling" on the files was
                     70: ;; (i.e., signature, encrypted); this shows up in mode line, not file!
                     71: 
                     72: (defun pgp-continue-frob (out-filename prev-buffer)
                     73:   (cond ((file-exists-p out-filename)
                     74:         (set-buffer (get-buffer-create "*PGP Output*"))
                     75:         (make-variable-buffer-local 'pgp-prev-buffer)
                     76:         (setq pgp-prev-buffer nil)
                     77:         (setq buffer-read-only nil)
                     78:         (erase-buffer)
                     79:         (insert-file-contents out-filename)
                     80:         (delete-file out-filename)
                     81:         (switch-to-buffer "*PGP Output*")
                     82:         (pgp-output-mode)
                     83:         (setq pgp-prev-buffer prev-buffer))
                     84:        (t (message "PGP command completed with no output file" ))))
                     85: 
                     86: (defun pgp-continue-in-place  (out-file buf min max cont)
                     87:   (cond ((file-exists-p out-file)
                     88:         (switch-to-buffer buf)
                     89:         (goto-char min)
                     90:         (delete-region min max)
                     91:         (insert-file-contents out-file)
                     92:         (delete-file out-file)
                     93:         (apply cont nil))
                     94:        (t (message "PGP command completed with no output file"))))
                     95: 
                     96: (defun pgp-mail-continue ()
                     97:   (mail-to)
                     98:   (insert (save-excursion
                     99:            (set-buffer "*PGP*")        ;!!!
                    100:            (goto-char (point-min))
                    101:            (re-search-forward "Recipient's")
                    102:            (re-search-forward "user ID: \\(.*$\\)")
                    103:            (buffer-substring (match-beginning 1) (match-end 1)))))
                    104: 
                    105: (defvar pgp-base-file-name nil
                    106:   "Default base file name for PGP temp files; defaults to a file in
                    107: /tmp with your UNIX user id in it.")
                    108: 
                    109: (defun pgp-check-tempname ()
                    110:   (if pgp-base-file-name
                    111:       ()
                    112:     (setq pgp-base-file-name  (format "/tmp/pgp%d" (user-real-uid)))))
                    113: 
                    114: (defun pgp-frob-region-1 (min max cont1 &optional opt1 opt2)
                    115:   (pgp-check-tempname)
                    116:   (let ((temp-filename (format "%s.txt" pgp-base-file-name))
                    117:        (out-filename  (format "%s.asc" pgp-base-file-name))
                    118:        (prev-buffer (current-buffer)))
                    119:     (if (file-exists-p temp-filename)
                    120:        (delete-file temp-filename))
                    121:     (if (file-exists-p out-filename)
                    122:        (delete-file out-filename))
                    123:     (write-region min max temp-filename)
                    124:     
                    125:     (let ((buf (get-buffer-create "*PGP*")))
                    126:       (switch-to-buffer buf)
                    127:       (erase-buffer)
                    128:       (let ((terminal-mode-hook
                    129:             (function
                    130:              (lambda ()
                    131:                (make-variable-buffer-local 'terminal-finished-hook) 
                    132:                (setq terminal-finished-hook (apply cont1 out-filename prev-buffer nil))
                    133:                (setq termhook-finished t)
                    134:                (if (and
                    135:                     (boundp 'pgp-finished)
                    136:                     pgp-finished)
                    137:                    (let ((nhooks terminal-finished-hook))
                    138:                      (fundamental-mode) ; in the *PGP* buffer; nukes hooks!
                    139:                      (run-hooks 'nhooks)))))))
                    140:        (terminal-emulator buf
                    141:                           pgp-program
                    142:                           (nconc (list "-o" out-filename)
                    143:                                  opt1
                    144:                                  (list temp-filename)
                    145:                                  opt2))))))
                    146: 
                    147: (defun pgp-frob-region  (min max &optional opt1 opt2)
                    148:   (pgp-frob-region-1 min max
                    149:                     (function
                    150:                      (lambda (out-filename buf)
                    151:                              (` (lambda () 
                    152:                                   (pgp-continue-frob
                    153:                                    (, out-filename)
                    154:                                    (, buf))))))
                    155:                     opt1 opt2))
                    156: 
                    157: (defun pgp-frob-region-in-place (min max &optional opt1 opt2 cont)
                    158:   (let ((cur-buf (current-buffer)))
                    159:     (pgp-frob-region-1 min max 
                    160:                       (function
                    161:                        (lambda (out-filename buf)
                    162:                          (` (lambda () 
                    163:                               (pgp-continue-in-place (, out-filename)
                    164:                                                      (, cur-buf)
                    165:                                                      (, min)
                    166:                                                      (, max)
                    167:                                                      (quote (, cont)))))))
                    168:                       opt1 opt2)))
                    169: 
                    170: (defun pgp-encrypt-ascii-region (min max to)
                    171:   (interactive "r\nsRecipient name: ")
                    172:   (pgp-frob-region min max (list "-eaw") (list to)))
                    173: 
                    174: (defun pgp-decrypt-ascii-region (min max)
                    175:   (interactive "r")
                    176:   (pgp-frob-region min max nil nil))
                    177: 
                    178: (defun pgp-sign-ascii-region (min max)
                    179:   "Sign the region with PGP, using cleartext signatures."
                    180:   (interactive "r")
                    181:   (pgp-frob-region min max (list "-swat") nil))
                    182: 
                    183: (defun pgp-encrypt-ascii-buffer (to)
                    184:   "Encrypt a buffer and use PGP armor for the output."
                    185:   (interactive "sRecipient name: ")
                    186:   (pgp-encrypt-ascii-region (point-min) (point-max) to))
                    187: 
                    188: (defun pgp-decrypt-ascii-buffer ()
                    189:   "Apply PGP to the current buffer."
                    190:   (interactive)
                    191:   (pgp-decrypt-ascii-region (point-min) (point-max)))
                    192: 
                    193: (defun pgp-sign-encrypt-ascii-buffer (to)
                    194:   (interactive "sRecipient name: ")
                    195:   (pgp-frob-region (point-min) (point-max) (list "-seaw") (list to)))
                    196: 
                    197: (defun pgp-sign-ascii-buffer ()
                    198:   "Sign the current buffer with PGP, using cleartext signatures."
                    199:   (interactive)
                    200:   (pgp-sign-ascii-region (point-min) (point-max)))
                    201: 
                    202: (defun pgp-sign-encrypt-ascii-buffer-in-place (to)
                    203:   (interactive "s(in place) Recipient name: ")
                    204:   (pgp-frob-region-in-place (point-min) (point-max) (list "-seaw") (list to)))
                    205: 
                    206: (defun pgp-sign-encrypt-ascii-region (min max to)
                    207:    (interactive "r\nsRecipient name: ")
                    208:    (pgp-frob-region min max (list "-seaw") (list to)))
                    209: 
                    210: (defvar pgp-mail-frob-flags "-easw"
                    211:   "*Flags to pass to pgp for frobbing mail.")
                    212: 
                    213: (defun pgp-frob-mail (to)
                    214:   "Take an in-progress mail message and 'frob' it."
                    215:   (interactive "sMail Recipient name: ")
                    216:   (goto-char (point-min))
                    217:   (re-search-forward mail-header-separator)
                    218:   (goto-char (match-beginning 0))
                    219:   (forward-line 1)
                    220:   (save-excursion
                    221:     (insert (buffer-substring (point-min) (point))))
                    222:   (pgp-frob-region-in-place (point) (point-max)
                    223:                            (list pgp-mail-frob-flags "-u" pgp-sender-name)
                    224:                            (list to)
                    225:                            'pgp-mail-continue))
                    226: 
                    227: (global-set-key "\C-c\C-p\C-e" 'pgp-encrypt-ascii-buffer)
                    228: (global-set-key "\C-c\C-p\C-r" 'pgp-encrypt-ascii-region)
                    229: (global-set-key "\C-c\C-p\C-s" 'pgp-sign-ascii-buffer)
                    230: (global-set-key "\C-c\C-p\C-m" 'pgp-frob-mail)
                    231: (global-set-key "\C-c\C-p\C-d" 'pgp-decrypt-ascii-buffer)
                    232: 
                    233: (global-set-key "\C-cpm" 'pgp-frob-mail)
                    234: (define-key rmail-mode-map "V" 'pgp-decrypt-ascii-buffer)
                    235: 
                    236: ;;; How to deal with the race?  the sentinel may get called
                    237: ;;; *before* terminal-emulator finishes its initialization.  So we set
                    238: ;;; up a local variable here so that our terminal-mode-hook will undo
                    239: ;;; the damage if PGP is finished.
                    240: ;;
                    241: ;; from terminal.el, modified:
                    242: 
                    243: (defun te-sentinel (process message)
                    244:   (cond ((eq (process-status process) 'run))
                    245:        ((null (buffer-name (process-buffer process)))) ;deleted
                    246:        (t (let ((b (current-buffer))
                    247:                 (done-hooks (and       ; added: WES
                    248:                              (boundp 'terminal-finished-hook)
                    249:                              terminal-finished-hook)))
                    250:             (save-excursion
                    251:               (set-buffer (process-buffer process))
                    252:               (setq buffer-read-only nil)
                    253:               (goto-char (point-max))
                    254:               (delete-blank-lines)
                    255:               (delete-horizontal-space)
                    256:               (insert "\n*******\n" message "*******\n")
                    257:               (fundamental-mode)       ; added/moved: WES/JTK
                    258:               (setq pgp-finished t)    ; JTK
                    259:               (sit-for 1))
                    260:             (if (and (eq b (process-buffer process))
                    261:                      (waiting-for-user-input-p))
                    262:                 (progn (goto-char (point-max))
                    263:                        (recenter -1)))
                    264:                 (run-hooks 'done-hooks))))) ;added: WES
                    265: 
                    266: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.