diff options
Diffstat (limited to 'lisp/mail/ietf-drums.el')
| -rw-r--r-- | lisp/mail/ietf-drums.el | 50 |
1 files changed, 28 insertions, 22 deletions
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 51c3e63e044..d1ad671b160 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -25,16 +25,6 @@ ;; library is based on draft-ietf-drums-msg-fmt-05.txt, released on ;; 1998-08-05. -;; Pending a real regression self test suite, Simon Josefsson added -;; various self test expressions snipped from bug reports, and their -;; expected value, below. I you believe it could be useful, please -;; add your own test cases, or write a real self test suite, or just -;; remove this. - -;; <m3oekvfd50.fsf@whitebox.m5r.de> -;; (ietf-drums-parse-address "'foo' <foo@example.com>") -;; => ("foo@example.com" . "'foo'") - ;;; Code: (eval-when-compile (require 'cl-lib)) @@ -75,6 +65,21 @@ backslash and doublequote.") (modify-syntax-entry ?\' "_" table) table)) +(defvar ietf-drums-comment-syntax-table + (let ((table (copy-syntax-table ietf-drums-syntax-table))) + (modify-syntax-entry ?\" "w" table) + table) + "In comments, DQUOTE is normal and does not start a string.") + +(defun ietf-drums--skip-comment () + ;; From just before the start of a comment, go to the end. Returns + ;; point. If the comment is unterminated, go to point-max. + (condition-case () + (with-syntax-table ietf-drums-comment-syntax-table + (forward-sexp 1)) + (scan-error (goto-char (point-max)))) + (point)) + (defun ietf-drums-token-to-list (token) "Translate TOKEN into a list of characters." (let ((i 0) @@ -119,14 +124,7 @@ backslash and doublequote.") (forward-sexp 1) (error (goto-char (point-max))))) ((eq c ?\() - (delete-region - (point) - (condition-case nil - (with-syntax-table (copy-syntax-table ietf-drums-syntax-table) - (modify-syntax-entry ?\" "w") - (forward-sexp 1) - (point)) - (error (point-max))))) + (delete-region (point) (ietf-drums--skip-comment))) (t (forward-char 1)))) (buffer-string)))) @@ -140,9 +138,11 @@ backslash and doublequote.") (setq c (char-after)) (cond ((eq c ?\") - (forward-sexp 1)) + (condition-case () + (forward-sexp 1) + (scan-error (goto-char (point-max))))) ((eq c ?\() - (forward-sexp 1)) + (ietf-drums--skip-comment)) ((memq c '(?\ ?\t ?\n ?\r)) (delete-char 1)) (t @@ -191,6 +191,8 @@ the Content-Transfer-Encoding header of a mail." "Parse STRING and return a MAILBOX / DISPLAY-NAME pair. If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed (that's the \"=?utf...q...=?\") stuff." + (when decode + (require 'rfc2047)) (with-temp-buffer (let (display-name mailbox c display-string) (ietf-drums-init string) @@ -240,7 +242,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed (cons (mapconcat #'identity (nreverse display-name) "") (ietf-drums-get-comment string))) - (cons mailbox (if decode + (cons mailbox (if (and decode display-string) (rfc2047-decode-string display-string) display-string)))))) @@ -292,9 +294,13 @@ a list of address strings." (replace-match " " t t)) (goto-char (point-min))) +(declare-function ietf-drums-parse-date-string "ietf-drums-date" + (time-string &optional error? no-822?)) + (defun ietf-drums-parse-date (string) "Return an Emacs time spec from STRING." - (encode-time (parse-time-string string))) + (require 'ietf-drums-date) + (encode-time (ietf-drums-parse-date-string string))) (defun ietf-drums-narrow-to-header () "Narrow to the header section in the current buffer." |