From 368fb9cb0a97357e3c626b7139fb4a0a0cd3d548 Mon Sep 17 00:00:00 2001 From: morioka Date: Sat, 16 Jan 1999 10:49:34 +0000 Subject: [PATCH] (eword-encoded-word-regexp): Must define when this module is compiled. (eword-decode-structured-field-body): Add new optional argument `start'. (eword-decode-and-unfold-structured-field-body): Likewise. (eword-decode-and-fold-structured-field-body): Likewise. (eword-analyze-quoted-string): Add new argument `start'; return ( . ) instead of ( . ). (std11-analyze-domain-literal): Likewise. (eword-analyze-domain-literal): Likewise. (eword-analyze-comment): Changed to alias of `eword-parse-comment'. (eword-analyze-spaces): Add new argument `start'; return ( . ) instead of ( . ). (std11-analyze-domain-literal): Likewise. (eword-analyze-special): Likewise. (eword-analyze-encoded-word): Likewise. (eword-analyze-atom): Likewise. (eword-lexical-analyze-internal): Add new argument `start'. (eword-lexical-analyze): Change interface to add new optional argument `start'. (eword-extract-address-components): Add new optional argument `start'. --- eword-decode.el | 150 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 85 insertions(+), 65 deletions(-) diff --git a/eword-decode.el b/eword-decode.el index 1ee95d6..b2aab2d 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -53,20 +53,21 @@ (eval-and-compile (defconst eword-encoded-text-regexp "[!->@-~]+") + + (defconst eword-encoded-word-regexp + (eval-when-compile + (concat (regexp-quote "=?") + "\\(" + mime-charset-regexp + "\\)" + (regexp-quote "?") + "\\(B\\|Q\\)" + (regexp-quote "?") + "\\(" + eword-encoded-text-regexp + "\\)" + (regexp-quote "?=")))) ) -(defconst eword-encoded-word-regexp - (eval-when-compile - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-regexp - "\\)" - (regexp-quote "?=")))) ;;; @ for string @@ -110,8 +111,9 @@ such as a version of Net$cape)." )) (defun eword-decode-structured-field-body (string - &optional start-column max-column) - (let ((tokens (eword-lexical-analyze string 'must-unfold)) + &optional start-column max-column + start) + (let ((tokens (eword-lexical-analyze string start 'must-unfold)) (result "") token) (while tokens @@ -123,7 +125,8 @@ such as a version of Net$cape)." (defun eword-decode-and-unfold-structured-field-body (string &optional start-column - max-column) + max-column + start) "Decode and unfold STRING as structured field body. It decodes non us-ascii characters in FULL-NAME encoded as encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii @@ -131,7 +134,7 @@ characters are regarded as variable `default-mime-charset'. If an encoded-word is broken or your emacs implementation can not decode the charset included in it, it is not decoded." - (let ((tokens (eword-lexical-analyze string 'must-unfold)) + (let ((tokens (eword-lexical-analyze string start 'must-unfold)) (result "")) (while tokens (let* ((token (car tokens)) @@ -146,14 +149,15 @@ decode the charset included in it, it is not decoded." (defun eword-decode-and-fold-structured-field-body (string start-column - &optional max-column) + &optional max-column + start) (if (and eword-max-size-to-decode (> (length string) eword-max-size-to-decode)) string (or max-column (setq max-column fill-column)) (let ((c start-column) - (tokens (eword-lexical-analyze string 'must-unfold)) + (tokens (eword-lexical-analyze string start 'must-unfold)) (result "") token) (while (and (setq token (car tokens)) @@ -612,18 +616,20 @@ be the result." :group 'eword-decode :type '(repeat function)) -(defun eword-analyze-quoted-string (string &optional must-unfold) - (let ((p (std11-check-enclosure string ?\" ?\"))) +(defun eword-analyze-quoted-string (string start &optional must-unfold) + (let ((p (std11-check-enclosure string ?\" ?\" nil start))) (if p (cons (cons 'quoted-string (decode-mime-charset-string - (std11-strip-quoted-pair (substring string 1 (1- p))) + (std11-strip-quoted-pair + (substring string (1+ start) (1- p))) default-mime-charset)) - (substring string p)) + ;;(substring string p)) + p) ))) -(defun eword-analyze-domain-literal (string &optional must-unfold) - (std11-analyze-domain-literal string)) +(defun eword-analyze-domain-literal (string start &optional must-unfold) + (std11-analyze-domain-literal string start)) (defun eword-parse-comment (string &optional from must-unfold) (let ((len (length string)) @@ -690,84 +696,97 @@ be the result." )) ))))) -(defun eword-analyze-comment (string &optional must-unfold) - (let ((ret (eword-parse-comment string 0 must-unfold))) - (if ret - (cons (car ret) - (substring string (cdr ret)) - )))) +;; (defun eword-analyze-comment (string start &optional must-unfold) +;; (let ((ret (eword-parse-comment string start must-unfold))) +;; (if ret +;; (cons (car ret) +;; (substring string (cdr ret)) +;; )))) +(defalias 'eword-analyze-comment 'eword-parse-comment) -(defun eword-analyze-spaces (string &optional must-unfold) - (std11-analyze-spaces string)) +(defun eword-analyze-spaces (string start &optional must-unfold) + (std11-analyze-spaces string start)) -(defun eword-analyze-special (string &optional must-unfold) - (std11-analyze-special string)) +(defun eword-analyze-special (string start &optional must-unfold) + (std11-analyze-special string start)) -(defun eword-analyze-encoded-word (string &optional must-unfold) - (if (eq (string-match eword-encoded-word-regexp string) 0) +(defun eword-analyze-encoded-word (string start &optional must-unfold) + (if (and (string-match eword-encoded-word-regexp string start) + (= (match-beginning 0) start)) (let ((end (match-end 0)) (dest (eword-decode-encoded-word (match-string 0 string) must-unfold)) ) - (setq string (substring string end)) - (while (eq (string-match `,(concat "[ \t\n]*\\(" - eword-encoded-word-regexp - "\\)") - string) - 0) + ;;(setq string (substring string end)) + (setq start end) + (while (and (string-match (eval-when-compile + (concat "[ \t\n]*\\(" + eword-encoded-word-regexp + "\\)")) + string start) + (= (match-beginning 0) start)) (setq end (match-end 0)) (setq dest (concat dest (eword-decode-encoded-word (match-string 1 string) must-unfold)) - string (substring string end)) + ;;string (substring string end)) + start end) ) - (cons (cons 'atom dest) string) + (cons (cons 'atom dest) ;;string) + end) ))) -(defun eword-analyze-atom (string &optional must-unfold) - (if (string-match std11-atom-regexp string) +(defun eword-analyze-atom (string start &optional must-unfold) + (if (and (string-match std11-atom-regexp string start) + (= (match-beginning 0) start)) (let ((end (match-end 0))) (cons (cons 'atom (decode-mime-charset-string - (substring string 0 end) + (substring string start end) default-mime-charset)) - (substring string end) - )))) + ;;(substring string end) + end) + ))) -(defun eword-lexical-analyze-internal (string must-unfold) - (let (dest ret) - (while (not (string-equal string "")) +(defun eword-lexical-analyze-internal (string start must-unfold) + (let ((len (length string)) + dest ret) + (while (< start len) (setq ret (let ((rest eword-lexical-analyzers) func r) (while (and (setq func (car rest)) - (null (setq r (funcall func string must-unfold))) + (null + (setq r (funcall func string start must-unfold))) ) (setq rest (cdr rest))) - (or r `((error . ,string) . "")) + (or r + (list (cons 'error (substring string start)) (1+ len))) )) - (setq dest (cons (car ret) dest)) - (setq string (cdr ret)) + (setq dest (cons (car ret) dest) + start (cdr ret)) ) (nreverse dest) )) -(defun eword-lexical-analyze (string &optional must-unfold) +(defun eword-lexical-analyze (string &optional start must-unfold) "Return lexical analyzed list corresponding STRING. It is like std11-lexical-analyze, but it decodes non us-ascii characters encoded as encoded-words or invalid \"raw\" format. \"Raw\" non us-ascii characters are regarded as variable `default-mime-charset'." - (let ((key (copy-sequence string)) - ret) + (let ((key (substring string (or start 0))) + ret cell) (set-text-properties 0 (length key) nil key) (if (setq ret (assoc key eword-lexical-analyze-cache)) (cdr ret) - (setq ret (eword-lexical-analyze-internal key must-unfold)) + (setq ret (eword-lexical-analyze-internal key 0 must-unfold)) (setq eword-lexical-analyze-cache (cons (cons key ret) - (last eword-lexical-analyze-cache - eword-lexical-analyze-cache-max))) + eword-lexical-analyze-cache)) + (if (cdr (setq cell (nthcdr eword-lexical-analyze-cache-max + eword-lexical-analyze-cache))) + (setcdr cell nil)) ret))) (defun eword-decode-token (token) @@ -790,7 +809,7 @@ characters encoded as encoded-words or invalid \"raw\" format. )) (t value)))) -(defun eword-extract-address-components (string) +(defun eword-extract-address-components (string &optional start) "Extract full name and canonical address from STRING. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. @@ -799,7 +818,8 @@ encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii characters are regarded as variable `default-mime-charset'." (let* ((structure (car (std11-parse-address (eword-lexical-analyze - (std11-unfold-string string) 'must-unfold)))) + (std11-unfold-string string) start + 'must-unfold)))) (phrase (std11-full-name-string structure)) (address (std11-address-string structure)) ) -- 1.7.10.4