+2000-02-08 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * Makefile: (texinfmt, xtexinfmt): New rule to format Texinfo
+ file with Emacs and XEmacs.
+
+2000-02-07 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * mime-edit.el: Fix doc string.
+ * mime-view.el: Ditto.
+ * pgg-gpg.el: Ditto.
+ * pgg-parse.el: Ditto.
+ * pgg-pgp.el: Ditto.
+ * pgg-pgp5.el: Ditto.
+ * pgg.el: Ditto.
+
+2000-02-07 Yoshiki Hayashi <yoshiki@xemacs.org>
+
+ * mime-view.el (mime-display-entity): Don't call
+ mime-goto-header-start-point. Clean up and remove redundant
+ let clause.
+
2000-02-07 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
* EMY 1.13.2 is released.
%.info: %.texi
makeinfo -o $@ $<
+texinfmt: emy.texi
+ $(EMACS) $(TEXINFMT) emy.texi $(TEXIF)
+
+xtexinfmt: emy.texi
+ $(XEMACS) $(TEXINFMT) emy.texi $(TEXIF)
+
clean:
-$(RM) $(GOMI)
(defcustom mime-edit-attach-at-end-type nil
"*List of MIME types to be attached at the end of a message.
-Values must be strings indicates MIME types. You can specify
+Values must be strings indicates MIME types. You can specify
either type/subtype or type only."
:group 'mime-edit
:type '(choice (const :tag "Nothing" nil)
(defvar mime-transfer-level-string
(mime-encoding-name mime-transfer-level 'not-omit)
- "A string formatted version of mime-transfer-level")
+ "A string formatted version of `mime-transfer-level'.")
(make-variable-buffer-local 'mime-transfer-level-string)
(defvar mime-edit-yank-ignored-field-list
'("Received" "Approved" "Path" "Replied" "Status"
"Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*")
- "Delete these fields from original message when it is inserted
-as message/rfc822 part.
+ "List of ignored header fields when inserting message/rfc822.
Each elements are regexp of field-name.")
(defvar mime-edit-yank-ignored-field-regexp
(defcustom mime-edit-message-max-lines-alist
'((news-reply-mode . 500))
- "Alist of major-mode vs maximum lines of a message.
-If it is not specified for a major-mode,
+ "Alist of `major-mode' vs maximum lines of a message.
+If it is not specified for a `major-mode',
`mime-edit-message-default-max-lines' is used."
:group 'mime-edit
:type 'list)
"Unconditionally turn on MIME-Edit mode."
(interactive)
(if mime-edit-mode-flag
- (error "You are already editing a MIME message.")
+ (error "You are already editing a MIME message")
(setq mime-edit-mode-flag t)
;; Set transfer level into mode line
(defun mime-edit-exit (&optional nomime no-error)
"Translate the tagged MIME message into a MIME compliant message.
-With no argument encode a message in the buffer into MIME, otherwise
-just return to previous mode."
+When NOMIME is nil, encode a message in the buffer into MIME.
+Otherwise, just returns to previous mode. If NO-ERROR is non-nil,
+no errors will be signaled even if it is not MIME-Edit mode."
(interactive "P")
(if (not mime-edit-mode-flag)
(if (null no-error)
- (error "You aren't editing a MIME message."))
+ (error "You aren't editing a MIME message"))
(if (not nomime)
(progn
(run-hooks 'mime-edit-translate-hook)
(enriched-mode -1))))))
(defun mime-edit-insert-file (file &optional verbose)
- "Insert a message from a file."
+ "Insert a message from a FILE.
+If VERBOSE is non-nil, it will prompt for Content-Type,
+Content-Transfer-Encoding and Content-Disposition headers."
(interactive "fInsert file as MIME message: \nP")
(let* ((guess (mime-find-file-type file))
(type (nth 0 guess))
(defun mime-make-text-tag (&optional subtype)
"Make a tag for a text after current point.
Subtype of text type can be specified by an optional argument SUBTYPE.
-Otherwise, it is obtained from mime-content-types."
+Otherwise, it is obtained from `mime-content-types'."
(let* ((pritype "text")
(subtype (or subtype
(car (car (cdr (assoc pritype mime-content-types)))))))
(save-excursion
(save-restriction
(let* ((from (std11-field-body "From" mail-header-separator))
- (ret (progn
+ (ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
(if encoding
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
- (or (let ((pgg-default-user-id
+ (or (let ((pgg-default-user-id
(or mime-edit-pgp-user-id
- (if from
+ (if from
(nth 1 (std11-extract-address-components from))
pgg-default-user-id))))
(pgg-sign-region (point-min)(point-max)))
(setq micalg
(cdr (assq 'hash-algorithm
(cdar (with-current-buffer pgg-output-buffer
- (pgg-parse-armor-region
+ (pgg-parse-armor-region
(point-min)(point-max))))))
- micalg
+ micalg
(if micalg
(concat "; micalg=pgp-" (downcase (symbol-name micalg)))
""))
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
(eword-encode-header)
- (or (let ((pgg-default-user-id
+ (or (let ((pgg-default-user-id
(or mime-edit-pgp-user-id
- (if from
+ (if from
(nth 1 (std11-extract-address-components from))
- pgg-default-user-id))))
- (pgg-encrypt-region
- (point-min) (point-max)
+ pgg-default-user-id))))
+ (pgg-encrypt-region
+ (point-min) (point-max)
(mapcar (lambda (recipient)
(nth 1 (std11-extract-address-components
recipient)))
- (split-string recipients
+ (split-string recipients
"\\([ \t\n]*,[ \t\n]*\\)+"))))
(throw 'mime-edit-error 'pgp-error))
(delete-region (point-min)(point-max))
(defun mime-edit-sign-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
+ (let* ((ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
(defun mime-edit-encrypt-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
+ (let* ((ret (progn
(narrow-to-region beg end)
(mime-edit-translate-region beg end boundary)))
(ctype (car ret))
(if arg
(progn
(or (memq 'sign mime-edit-pgp-processing)
- (setq mime-edit-pgp-processing
- (nconc mime-edit-pgp-processing
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
(copy-sequence '(sign)))))
(message "This message will be signed."))
- (setq mime-edit-pgp-processing
+ (setq mime-edit-pgp-processing
(delq 'sign mime-edit-pgp-processing))
(message "This message will not be signed.")))
(if arg
(progn
(or (memq 'encrypt mime-edit-pgp-processing)
- (setq mime-edit-pgp-processing
- (nconc mime-edit-pgp-processing
+ (setq mime-edit-pgp-processing
+ (nconc mime-edit-pgp-processing
(copy-sequence '(encrypt)))))
(message "This message will be encrypt."))
(setq mime-edit-pgp-processing
(dolist (pgp-processing mime-edit-pgp-processing)
(case pgp-processing
(sign
- (mime-edit-enclose-pgp-signed-region
+ (mime-edit-enclose-pgp-signed-region
beg (point-max)))
(encrypt
- (mime-edit-enclose-pgp-encrypted-region
+ (mime-edit-enclose-pgp-encrypted-region
beg (point-max))))))))
(goto-char (point-min))
(re-search-forward "^-+BEGIN PGP MESSAGE-+$"
nil t))
- (prog1
+ (prog1
(save-window-excursion
(pgg-decrypt-region (match-beginning 0)
(point-max)))
(delete-region (point-min)(point-max))))
(insert-buffer-substring pgg-output-buffer)
- (mime-edit-decode-message-in-buffer
+ (mime-edit-decode-message-in-buffer
nil not-decode-text)
(delete-region (goto-char (point-min))
(if (search-forward "\n\n" nil t)
(match-end 0)
(point-min)))
(goto-char (point-max))))
- (t
+ (t
(mime-edit-decode-message-in-buffer
(if (eq subtype 'digest)
(eval-when-compile
(defcustom mime-preview-move-scroll nil
"*Decides whether to scroll when moving to next entity.
-When t, scroll the buffer. Non-nil but not t means scroll when
-the next entity is within next-screen-context-lines from top or
-buttom. Nil means don't scroll at all."
+When t, scroll the buffer. Non-nil but not t means scroll when
+the next entity is within `next-screen-context-lines' from top or
+buttom. Nil means don't scroll at all."
:group 'mime-view
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)
'((mime-show-message-mode . binary)
(mime-temp-message-mode . binary)
(t . cooked))
- "Alist of major-mode vs. representation-type of mime-raw-buffer.
+ "Alist of `major-mode' vs. representation-type of mime-raw-buffer.
Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is
-major-mode or t. t means default. REPRESENTATION-TYPE must be
+`major-mode' or t. t means default. REPRESENTATION-TYPE must be
`binary' or `cooked'.")
;; (make-variable-buffer-local 'mime-raw-buffer)
(defvar mime-preview-original-window-configuration nil
- "Window-configuration before mime-view-mode is called.")
+ "Window-configuration before `mime-view-mode' is called.")
(make-variable-buffer-local 'mime-preview-original-window-configuration)
(defun mime-preview-original-major-mode (&optional recursive point)
i (1+ i)))))
(defun mime-display-detect-application/octet-stream (entity situation)
- "Detect unknown part and display it inline.
+ "Detect unknown ENTITY and display it inline.
This can only handle gzipped contents."
(or (and (mime-entity-filename entity)
(string-match "\\.gz$" (mime-entity-filename entity))
(mime-display-text/plain entity situation)))
(defun mime-display-gzipped (entity situation)
- "Ungzip gzipped part and display"
+ "Ungzip gzipped part and display."
(insert
(with-temp-buffer
(insert (mime-entity-content entity))
t)
(defun mime-preview-inline ()
- "View part as text without code conversion"
+ "View part as text without code conversion."
(interactive)
(let ((inhibit-read-only t)
(entity (get-text-property (point) 'mime-view-entity))
(defun mime-preview-type ()
- "View part as text without code conversion"
+ "View part as text without code conversion."
(interactive)
(let ((inhibit-read-only t)
(entity (get-text-property (point) 'mime-view-entity))
(defvar mime-preview-quitting-method-alist
'((mime-show-message-mode
. mime-preview-quitting-method-for-mime-show-message-mode))
- "Alist of major-mode vs. quitting-method of mime-view.")
+ "Alist of `major-mode' vs. quitting-method of mime-view.")
(defvar mime-preview-over-to-previous-method-alist nil
- "Alist of major-mode vs. over-to-previous-method of mime-view.")
+ "Alist of `major-mode' vs. over-to-previous-method of mime-view.")
(defvar mime-preview-over-to-next-method-alist nil
- "Alist of major-mode vs. over-to-next-method of mime-view.")
+ "Alist of `major-mode' vs. over-to-next-method of mime-view.")
;;; @ following method
;;;
(defvar mime-preview-following-method-alist nil
- "Alist of major-mode vs. following-method of mime-view.")
+ "Alist of `major-mode' vs. following-method of mime-view.")
(defvar mime-view-following-required-fields-list
'("From"))
(defun mime-display-entity (entity &optional situation
default-situation preview-buffer)
+ "Display mime-entity ENTITY."
(or preview-buffer
(setq preview-buffer (current-buffer)))
- (let (e nb ne nhb nbb)
- (mime-goto-header-start-point entity)
- (in-calist-package 'mime-view)
- (or situation
- (setq situation
- (or (ctree-match-calist mime-preview-condition
- (append (mime-entity-situation entity)
- default-situation))
- default-situation)))
- (let ((button-is-invisible
- (or (eq (cdr (assq 'entity-button situation)) 'invisible)
- (not (mime-view-entity-button-visible-p entity))))
- (header-is-visible
- (eq (cdr (assq 'header situation)) 'visible))
- (header-presentation-method
- (or (cdr (assq 'header-presentation-method situation))
- (cdr (assq (cdr (assq 'major-mode situation))
- mime-header-presentation-method-alist))))
- (body-is-visible
- (eq (cdr (assq 'body situation)) 'visible))
- (body-presentation-method
- (cdr (assq 'body-presentation-method situation)))
- (children (mime-entity-children entity)))
- ;; Check if attachment is specified.
- ;; if inline is forced or not.
- (unless (or (eq t mime-view-force-inline-types)
- (memq (mime-entity-media-type entity)
- mime-view-force-inline-types)
- (memq (mime-view-entity-type/subtype entity)
- mime-view-force-inline-types)
- ;; whether Content-Disposition header exists.
- (not (mime-entity-content-disposition entity))
- (eq 'inline
- (mime-content-disposition-type
- (mime-entity-content-disposition entity))))
- ;; This is attachment
- (setq header-is-visible nil
- body-is-visible nil))
- (set-buffer preview-buffer)
- (setq nb (point))
- (save-restriction
- (narrow-to-region nb nb)
- (or button-is-invisible
- (if (mime-view-entity-button-visible-p entity)
- (mime-view-insert-entity-button entity
- ;; work around composite type
- (not (or children
- body-is-visible)))))
- (when header-is-visible
- (setq nhb (point))
- (if header-presentation-method
- (funcall header-presentation-method entity situation)
- (mime-insert-header entity
- mime-view-ignored-field-list
- mime-view-visible-field-list))
- (run-hooks 'mime-display-header-hook)
- (put-text-property nhb (point-max) 'mime-view-entity-header entity)
- (goto-char (point-max))
- (insert "\n"))
- (setq nbb (point))
- (cond (children)
- ((and body-is-visible
- (functionp body-presentation-method))
- (funcall body-presentation-method entity situation))
- (t
- (when button-is-invisible
- (goto-char (point-max))
- (mime-view-insert-entity-button entity
- ;; work around composite type
- (not (or children
- body-is-visible))))
- (or header-is-visible
- (progn
- (goto-char (point-max))
- (insert "\n")))))
- (setq ne (point-max)))
- (put-text-property nb ne 'mime-view-entity entity)
- (put-text-property nb ne 'mime-view-situation situation)
- (put-text-property nbb ne 'mime-view-entity-body entity)
- (goto-char ne)
- (if children
- (if (functionp body-presentation-method)
- (funcall body-presentation-method entity situation)
- (mime-display-multipart/mixed entity situation))))))
+ (in-calist-package 'mime-view)
+ (or situation
+ (setq situation
+ (or (ctree-match-calist mime-preview-condition
+ (append (mime-entity-situation entity)
+ default-situation))
+ default-situation)))
+ (let ((button-is-invisible
+ (or (eq (cdr (assq 'entity-button situation)) 'invisible)
+ (not (mime-view-entity-button-visible-p entity))))
+ (header-is-visible
+ (eq (cdr (assq 'header situation)) 'visible))
+ (header-presentation-method
+ (or (cdr (assq 'header-presentation-method situation))
+ (cdr (assq (cdr (assq 'major-mode situation))
+ mime-header-presentation-method-alist))))
+ (body-is-visible
+ (eq (cdr (assq 'body situation)) 'visible))
+ (body-presentation-method
+ (cdr (assq 'body-presentation-method situation)))
+ (children (mime-entity-children entity))
+ e nb ne nhb nbb)
+ ;; Check if attachment is specified.
+ ;; if inline is forced or not.
+ (unless (or (eq t mime-view-force-inline-types)
+ (memq (mime-entity-media-type entity)
+ mime-view-force-inline-types)
+ (memq (mime-view-entity-type/subtype entity)
+ mime-view-force-inline-types)
+ ;; whether Content-Disposition header exists.
+ (not (mime-entity-content-disposition entity))
+ (eq 'inline
+ (mime-content-disposition-type
+ (mime-entity-content-disposition entity))))
+ ;; This is attachment
+ (setq header-is-visible nil
+ body-is-visible nil))
+ (set-buffer preview-buffer)
+ (setq nb (point))
+ (save-restriction
+ (narrow-to-region nb nb)
+ (or button-is-invisible
+ (if (mime-view-entity-button-visible-p entity)
+ (mime-view-insert-entity-button entity
+ ;; work around composite type
+ (not (or children
+ body-is-visible)))))
+ (when header-is-visible
+ (setq nhb (point))
+ (if header-presentation-method
+ (funcall header-presentation-method entity situation)
+ (mime-insert-header entity
+ mime-view-ignored-field-list
+ mime-view-visible-field-list))
+ (run-hooks 'mime-display-header-hook)
+ (put-text-property nhb (point-max) 'mime-view-entity-header entity)
+ (goto-char (point-max))
+ (insert "\n"))
+ (setq nbb (point))
+ (cond (children)
+ ((and body-is-visible
+ (functionp body-presentation-method))
+ (funcall body-presentation-method entity situation))
+ (t
+ (when button-is-invisible
+ (goto-char (point-max))
+ (mime-view-insert-entity-button entity
+ ;; work around composite type
+ (not (or children
+ body-is-visible))))
+ (or header-is-visible
+ (progn
+ (goto-char (point-max))
+ (insert "\n")))))
+ (setq ne (point-max)))
+ (put-text-property nb ne 'mime-view-entity entity)
+ (put-text-property nb ne 'mime-view-situation situation)
+ (put-text-property nbb ne 'mime-view-entity-body entity)
+ (goto-char ne)
+ (if children
+ (if (functionp body-presentation-method)
+ (funcall body-presentation-method entity situation)
+ (mime-display-multipart/mixed entity situation)))))
;;; @ MIME viewer mode
(raw "View text without code conversion" mime-preview-inline)
(text "View text with code conversion" mime-preview-text)
(type "View internally as type" mime-preview-type))
- "Menu for MIME Viewer")
+ "Menu for MIME Viewer.")
(cond ((featurep 'xemacs)
(defvar mime-view-xemacs-popup-menu
a Followup to current content.
q Quit
button-2 Move to point under the mouse cursor
- and decode current content as `play mode'
-"
+ and decode current content as `play mode'"
(interactive)
(unless mime-view-redisplay
(save-excursion
"GnuPG interface"
:group 'pgg)
-(defcustom pgg-gpg-program "gpg"
+(defcustom pgg-gpg-program "gpg"
"The GnuPG executable."
:group 'pgg-gpg
:type 'string)
(defcustom pgg-gpg-shell-file-name "/bin/sh"
- "File name to load inferior shells from. Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
:group 'pgg-gpg
:type 'string)
(defun pgg-gpg-process-region (start end passphrase program args)
(let* ((errors-file-name
- (concat temporary-file-directory
+ (concat temporary-file-directory
(make-temp-name "pgg-errors")))
(status-file-name
- (concat temporary-file-directory
+ (concat temporary-file-directory
(make-temp-name "pgg-status")))
- (args
+ (args
(append
`("--status-fd" "3"
,@(if passphrase '("--passphrase-fd" "0"))
(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-gpg)
string &optional type)
- (let ((args (list "--with-colons" "--no-greeting" "--batch"
+ (let ((args (list "--with-colons" "--no-greeting" "--batch"
(if type "--list-secret-keys" "--list-keys")
string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
(apply #'call-process pgg-gpg-program nil t nil args)
(goto-char (point-min))
(when (re-search-forward "^\\(sec\\|pub\\):" nil t)
- (substring
- (nth 3 (split-string
+ (substring
+ (nth 3 (split-string
(buffer-substring (match-end 0)
(progn (end-of-line)(point)))
":"))
8)))))
-(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg)
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg)
start end recipients)
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (args
+ (args
`("--batch" "--armor" "--always-trust" "--encrypt"
,@(if recipients
- (apply #'append
- (mapcar (lambda (rcpt)
- (list "--remote-user"
- (concat "\"" rcpt "\"")))
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "--remote-user"
+ (concat "\"" rcpt "\"")))
(append recipients
(if pgg-encrypt-for-me
(list pgg-gpg-user-id)))))))))
(pgg-process-when-success
(pgg-convert-lbt-region (point-min)(point-max) 'LF))))
-(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg)
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg)
start end)
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "GnuPG passphrase for %s: " pgg-gpg-user-id)
(pgg-scheme-lookup-key scheme pgg-gpg-user-id 'encrypt)))
(args '("--batch" "--decrypt")))
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)
(pgg-process-when-success nil)))
-(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg)
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg)
start end &optional cleartext)
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "GnuPG passphrase for %s: " pgg-gpg-user-id)
(pgg-scheme-lookup-key scheme pgg-gpg-user-id 'sign)))
- (args
+ (args
(list (if cleartext "--clearsign" "--detach-sign")
- "--armor" "--batch" "--verbose"
+ "--armor" "--batch" "--verbose"
"--local-user" pgg-gpg-user-id))
(inhibit-read-only t)
buffer-read-only)
(pgg-process-when-success
(pgg-convert-lbt-region (point-min)(point-max) 'LF)
(when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
- (let ((packet
- (cdr (assq 2 (pgg-parse-armor-region
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
(progn (beginning-of-line 2)
(point))
(point-max))))))
(if pgg-cache-passphrase
- (pgg-add-passphrase-cache
+ (pgg-add-passphrase-cache
(cdr (assq 'key-identifier packet))
passphrase)))))))
-(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg)
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg)
start end &optional signature)
(let ((args '("--batch" "--verify")))
(when (stringp signature)
(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-gpg))
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
- (args (list "--batch" "--export" "--armor"
+ (args (list "--batch" "--export" "--armor"
(concat "\"" pgg-gpg-user-id "\""))))
(pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
(insert-buffer-substring pgg-output-buffer)))
(set-buffer pgg-status-buffer)
(goto-char (point-min))
(when (re-search-forward "^\\[GNUPG:] +IMPORT_RES +" nil t)
- (setq status (buffer-substring (match-end 0)
- (progn (end-of-line)
+ (setq status (buffer-substring (match-end 0)
+ (progn (end-of-line)
(point)))
- status (vconcat (mapcar #'string-to-int
+ status (vconcat (mapcar #'string-to-int
(split-string status))))
(erase-buffer)
(insert (format "Imported %d key(s).
;; This module is based on
;; [OpenPGP] RFC 2440: "OpenPGP Message Format"
-;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;; by John W. Noerenberg, II <jwn2@qualcomm.com>,
;; Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
;; Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
;; (1998/11)
(2 . ZLIB))
"Alist of the assigned number to the compression algorithm."
:group 'pgg-parse
- :type 'alist)
+ :type 'alist)
(defcustom pgg-parse-signature-type-alist
'((0 . "Signature of a binary document")
(16 . "Generic certification of a User ID and Public Key packet")
(17 . "Persona certification of a User ID and Public Key packet")
(18 . "Casual certification of a User ID and Public Key packet")
- (19 . "Positive certification of a User ID and Public Key packet")
+ (19 . "Positive certification of a User ID and Public Key packet")
(24 . "Subkey Binding Signature")
(31 . "Signature directly on a key")
(32 . "Key revocation signature")
"^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
"^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
"^-----BEGIN PGP SIGNATURE-----\r?$")
- "Armor headers")
+ "Armor headers.")
(defmacro pgg-format-key-identifier (string)
`(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
`(char-int (char-after (prog1 (point) (forward-char)))))
(defmacro pgg-read-bytes-string (nbytes)
- `(buffer-substring
+ `(buffer-substring
(point) (prog1 (+ ,nbytes (point))
(forward-char ,nbytes))))
(logand (aref h 2) 255)))))
(defmacro pgg-parse-length-type (c)
- `(cond
+ `(cond
((< ,c 192) (cons ,c 1))
((< ,c 224)
- (cons (+ (lsh (- ,c 192) 8)
+ (cons (+ (lsh (- ,c 192) 8)
(pgg-byte-after (+ 2 (point)))
192)
2))
packet-bytes 0
header-bytes (1+ length-type))
(dotimes (i length-type)
- (setq packet-bytes
- (logior (lsh packet-bytes 8)
+ (setq packet-bytes
+ (logior (lsh packet-bytes 8)
(pgg-byte-after (+ 1 i (point)))))))
(setq content-tag (logand 63 ptag)
- length-type (pgg-parse-length-type
+ length-type (pgg-parse-length-type
(pgg-byte-after (1+ (point))))
packet-bytes (car length-type)
header-bytes (1+ (cdr length-type))))
;; 12 -- Trust Packet
(13 ;User ID Packet
(pgg-read-body-string ptag))
- ;; 14 -- Public Subkey Packet
+ ;; 14 -- Public Subkey Packet
;; 60 .. 63 -- Private or Experimental Values
))
(defun pgg-parse-packets (&optional header-parser body-parser)
(let ((header-parser
- (or header-parser
+ (or header-parser
(function pgg-parse-packet-header)))
(body-parser
- (or body-parser
+ (or body-parser
(function pgg-parse-packet)))
result ptag)
(while (> (point-max) (1+ (point)))
(setq ptag (funcall header-parser))
(pgg-skip-header ptag)
- (push (cons (car ptag)
- (save-excursion
+ (push (cons (car ptag)
+ (save-excursion
(funcall body-parser ptag)))
result)
(if (zerop (nth 1 ptag))
(defun pgg-parse-signature-subpacket (ptag)
(case (car ptag)
(2 ;signature creation time
- (cons 'creation-time
+ (cons 'creation-time
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
(3 ;signature expiration time
- (cons 'signature-expiry
+ (cons 'signature-expiry
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
(4 ;exportable certification
(5 ;trust signature
(cons 'trust-level (pgg-read-byte)))
(6 ;regular expression
- (cons 'regular-expression
+ (cons 'regular-expression
(pgg-read-body-string ptag)))
(7 ;revocable
(cons 'revocability (pgg-read-byte)))
(9 ;key expiration time
- (cons 'key-expiry
+ (cons 'key-expiry
(let ((bytes (pgg-read-bytes 4)))
(pgg-parse-time-field bytes))))
;; 10 = placeholder for backward compatibility
(cons 'notation
(let ((name-bytes (pgg-read-bytes 2))
(value-bytes (pgg-read-bytes 2)))
- (cons (pgg-read-bytes-string
+ (cons (pgg-read-bytes-string
(logior (lsh (car name-bytes) 8)
(nth 1 name-bytes)))
- (pgg-read-bytes-string
+ (pgg-read-bytes-string
(logior (lsh (car value-bytes) 8)
(nth 1 value-bytes)))))))
(21 ;preferred hash algorithms
(let* ((signature-version (pgg-byte-after))
(result (list (cons 'version signature-version)))
hashed-material field n)
- (cond
+ (cond
((= signature-version 3)
(pgg-skip-bytes 2)
(setq hashed-material (pgg-read-bytes 5))
- (pgg-set-alist result
- 'signature-type
+ (pgg-set-alist result
+ 'signature-type
(cdr (assq (pop hashed-material)
pgg-parse-signature-type-alist)))
(pgg-set-alist result
- 'creation-time
+ 'creation-time
(pgg-parse-time-field hashed-material))
(pgg-set-alist result
'key-identifier
((= signature-version 4)
(pgg-skip-bytes 1)
(pgg-set-alist result
- 'signature-type
+ 'signature-type
(cdr (assq (pgg-read-byte)
pgg-parse-signature-type-alist)))
(pgg-set-alist result
- 'public-key-algorithm
+ 'public-key-algorithm
(pgg-read-byte))
(pgg-set-alist result
'hash-algorithm (pgg-read-byte))
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
- (pgg-parse-packets
+ (pgg-parse-packets
#'pgg-parse-signature-subpacket-header
#'pgg-parse-signature-subpacket)))
(goto-char (point-max))))
(narrow-to-region (point)(+ n (point)))
(nconc result
(mapcar (function cdr) ;remove packet types
- (pgg-parse-packets
+ (pgg-parse-packets
#'pgg-parse-signature-subpacket-header
#'pgg-parse-signature-subpacket)))))))
'version (pgg-read-byte))
(pgg-set-alist result
'key-identifier
- (pgg-format-key-identifier
+ (pgg-format-key-identifier
(pgg-read-bytes-string 8)))
(pgg-set-alist result
'public-key-algorithm
(mime-decode-region (point-min) marker "base64")
(static-when (fboundp 'pgg-parse-crc24-string )
(or pgg-ignore-packet-checksum
- (string-equal
+ (string-equal
(funcall (mel-find-function 'mime-encode-string "base64")
- (pgg-parse-crc24-string
+ (pgg-parse-crc24-string
(buffer-substring (point-min)(point-max))))
checksum)
- (error "PGP packet checksum does not match.")))))
+ (error "PGP packet checksum does not match")))))
(defun pgg-decode-armor-region (start end)
(save-restriction
"PGP 2.* and 6.* interface"
:group 'pgg)
-(defcustom pgg-pgp-program "pgp"
+(defcustom pgg-pgp-program "pgp"
"PGP 2.* and 6.* executable."
:group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-shell-file-name "/bin/sh"
- "File name to load inferior shells from. Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
:group 'pgg-pgp
:type 'string)
(luna-define-class pgg-scheme-pgp (pgg-scheme)))
(defvar pgg-pgp-user-id nil
- "GnuPG ID of your default identity.")
+ "PGP ID of your default identity.")
(defvar pgg-scheme-pgp-instance nil)
(defun pgg-pgp-process-region (start end passphrase program args)
(let* ((errors-file-name
- (concat temporary-file-directory
+ (concat temporary-file-directory
(make-temp-name "pgg-errors")))
- (args
- (append args
+ (args
+ (append args
pgg-pgp-extra-args
(list (concat "2>" errors-file-name))))
(shell-file-name pgg-pgp-shell-file-name)
(if (and process (eq 'run (process-status process)))
(interrupt-process process)))))
-(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp)
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp)
string &optional type)
(let ((args (list "+batchmode" "+language=en" "-kv" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
(buffer-substring (point)(+ 8 (point))))
((re-search-forward "^Type" nil t);PGP 6.*
(beginning-of-line 2)
- (substring
- (nth 2 (split-string
+ (substring
+ (nth 2 (split-string
(buffer-substring (point)(progn (end-of-line) (point)))))
2))))))
-(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp)
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp)
start end recipients)
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
- (args
+ (args
`("+encrypttoself=off +verbose=1" "+batchmode"
"+language=us" "-fate"
,@(if recipients
(pgg-pgp-process-region start end nil pgg-pgp-program args)
(pgg-process-when-success nil)))
-(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp)
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp)
start end)
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp-user-id)
(pgg-scheme-lookup-key scheme pgg-pgp-user-id 'encrypt)))
- (args
+ (args
'("+verbose=1" "+batchmode" "+language=us" "-f")))
(pgg-pgp-process-region start end passphrase pgg-pgp-program args)
(pgg-process-when-success nil)))
-(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp)
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp)
start end &optional clearsign)
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp-user-id)
(pgg-scheme-lookup-key scheme pgg-pgp-user-id 'sign)))
- (args
+ (args
(list (if clearsign "-fast" "-fbast")
"+verbose=1" "+language=us" "+batchmode"
"-u" pgg-pgp-user-id)))
(pgg-process-when-success
(goto-char (point-min))
(when (re-search-forward "^-+BEGIN PGP" nil t);XXX
- (let ((packet
- (cdr (assq 2 (pgg-parse-armor-region
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
(progn (beginning-of-line 2)
(point))
(point-max))))))
(if pgg-cache-passphrase
- (pgg-add-passphrase-cache
+ (pgg-add-passphrase-cache
(cdr (assq 'key-identifier packet))
passphrase)))))))
-(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp)
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp)
start end &optional signature)
(let* ((basename (expand-file-name "pgg" temporary-file-directory))
(orig-file (make-temp-name basename))
(progn (beginning-of-line 2) (point)))))
(goto-char (point-min))
(when (re-search-forward "^\\.$" nil t)
- (delete-region (point-min)
+ (delete-region (point-min)
(progn (beginning-of-line 2)
(point)))))))
(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp))
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(args
- (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+ (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
(concat "\"" pgg-pgp-user-id "\""))))
(pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
(insert-buffer-substring pgg-output-buffer)))
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
(basename (expand-file-name "pgg" temporary-file-directory))
(key-file (make-temp-name basename))
- (args
- (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+ (args
+ (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
key-file)))
(write-region-as-raw-text-CRLF start end key-file)
(pgg-pgp-process-region start end nil pgg-pgp-program args)
"PGP 5.* interface"
:group 'pgg)
-(defcustom pgg-pgp5-pgpe-program "pgpe"
+(defcustom pgg-pgp5-pgpe-program "pgpe"
"PGP 5.* 'pgpe' executable."
:group 'pgg-pgp5
:type 'string)
-(defcustom pgg-pgp5-pgps-program "pgps"
+(defcustom pgg-pgp5-pgps-program "pgps"
"PGP 5.* 'pgps' executable."
:group 'pgg-pgp5
:type 'string)
-(defcustom pgg-pgp5-pgpk-program "pgpk"
+(defcustom pgg-pgp5-pgpk-program "pgpk"
"PGP 5.* 'pgpk' executable."
:group 'pgg-pgp5
:type 'string)
-(defcustom pgg-pgp5-pgpv-program "pgpv"
+(defcustom pgg-pgp5-pgpv-program "pgpv"
"PGP 5.* 'pgpv' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-shell-file-name "/bin/sh"
- "File name to load inferior shells from. Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
+ "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
:group 'pgg-pgp5
:type 'string)
:type 'string)
(defcustom pgg-pgp5-extra-args nil
- "Extra arguments for every PGP invocation."
+ "Extra arguments for every PGP 5.* invocation."
:group 'pgg-pgp5
:type 'string)
(luna-define-class pgg-scheme-pgp5 (pgg-scheme)))
(defvar pgg-pgp5-user-id nil
- "GnuPG ID of your default identity.")
+ "PGP 5.* ID of your default identity.")
(defvar pgg-scheme-pgp5-instance nil)
(defun pgg-pgp5-process-region (start end passphrase program args)
(let* ((errors-file-name
- (concat temporary-file-directory
+ (concat temporary-file-directory
(make-temp-name "pgg-errors")))
- (args
- (append args
+ (args
+ (append args
pgg-pgp5-extra-args
(list (concat "2>" errors-file-name))))
(shell-file-name pgg-pgp5-shell-file-name)
(if (and process (eq 'run (process-status process)))
(interrupt-process process)))))
-(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp5)
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp5)
string &optional type)
(let ((args (list "+language=en" "-l" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
(apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
(goto-char (point-min))
(when (re-search-forward "^sec" nil t)
- (substring
- (nth 2 (split-string
+ (substring
+ (nth 2 (split-string
(buffer-substring (match-end 0)(progn (end-of-line)(point)))))
2)))))
-(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp5)
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp5)
start end recipients)
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
- (args
+ (args
`("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
,@(if recipients
- (apply #'append
- (mapcar (lambda (rcpt)
- (list "-r"
- (concat "\"" rcpt "\"")))
+ (apply #'append
+ (mapcar (lambda (rcpt)
+ (list "-r"
+ (concat "\"" rcpt "\"")))
(append recipients
(if pgg-encrypt-for-me
(list pgg-pgp5-user-id)))))))))
(pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
(pgg-process-when-success nil)))
-(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp5)
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp5)
start end)
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp5-user-id)
(pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'encrypt)))
- (args
+ (args
'("+verbose=1" "+batchmode=1" "+language=us" "-f")))
(pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
(pgg-process-when-success nil)))
-(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp5)
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp5)
start end &optional clearsign)
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(passphrase
- (pgg-read-passphrase
+ (pgg-read-passphrase
(format "PGP passphrase for %s: " pgg-pgp5-user-id)
(pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'sign)))
- (args
+ (args
(list (if clearsign "-fat" "-fbat")
"+verbose=1" "+language=us" "+batchmode=1"
"-u" pgg-pgp5-user-id)))
(pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
(pgg-process-when-success
(when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
- (let ((packet
- (cdr (assq 2 (pgg-parse-armor-region
+ (let ((packet
+ (cdr (assq 2 (pgg-parse-armor-region
(progn (beginning-of-line 2)
(point))
(point-max))))))
(if pgg-cache-passphrase
- (pgg-add-passphrase-cache
+ (pgg-add-passphrase-cache
(cdr (assq 'key-identifier packet))
passphrase)))))))
-(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5)
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5)
start end &optional signature)
(let* ((basename (expand-file-name "pgg" temporary-file-directory))
(orig-file (make-temp-name basename))
(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp5))
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(args
- (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
(concat "\"" pgg-pgp5-user-id "\""))))
(pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
(insert-buffer-substring pgg-output-buffer)))
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
(basename (expand-file-name "pgg" temporary-file-directory))
(key-file (make-temp-name basename))
- (args
- (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+ (args
+ (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
key-file)))
(write-region-as-raw-text-CRLF start end key-file)
(pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
(luna-define-internal-accessors 'pgg-scheme))
(luna-define-generic pgg-scheme-lookup-key (scheme string &optional type)
- "Search keys associated with STRING")
+ "Search keys associated with STRING.")
(luna-define-generic pgg-scheme-encrypt-region (scheme start end recipients)
"Encrypt the current region between START and END.")
(luna-define-generic pgg-scheme-verify-region
(scheme start end &optional signature)
- "Verify region between START and END
-as the detached signature SIGNATURE.")
+ "Verify region between START and END as the detached signature SIGNATURE.")
(luna-define-generic pgg-scheme-insert-key (scheme)
"Insert public key at point.")
(luna-define-generic pgg-scheme-snarf-keys-region (scheme start end)
- "Add all public keys in region between START
-and END to the keyring.")
+ "Add all public keys in region between START and END to the keyring.")
;;; @ utility functions
;;;
(defun pgg-temp-buffer-show-function (buffer)
(let ((window (split-window-vertically
- (- (window-height)
+ (- (window-height)
(/ (window-height) 5)))))
(set-window-buffer window buffer)))
(delete-region start end)
(insert-buffer-substring pgg-output-buffer)
(decode-coding-region start (point) buffer-file-coding-system))
- (let ((temp-buffer-show-function
+ (let ((temp-buffer-show-function
(function pgg-temp-buffer-show-function)))
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(list (region-beginning)(region-end)
(split-string (read-string "Recipients: ") "[ \t,]+")))
(let* ((entity (pgg-make-scheme pgg-default-scheme))
- (status
+ (status
(pgg-save-coding-system start end
(pgg-scheme-encrypt-region entity (point-min)(point-max) rcpts))))
(when (interactive-p)
(buffer-disable-undo)
(set-buffer-multibyte nil)
(insert-file-contents signature)
- (cdr (assq 2 (pgg-decode-armor-region
+ (cdr (assq 2 (pgg-decode-armor-region
(point-min)(point-max)))))))
(scheme
(or pgg-scheme
projects / elisp / semi.git / commitdiff