From: akr Date: Mon, 17 Aug 1998 01:01:01 +0000 (+0000) Subject: * DOODLE-TIPS: New file. X-Git-Tag: doodle-1_9_0~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1107de851b970443c16b68389504902d5535ef07;p=elisp%2Fflim.git * DOODLE-TIPS: New file. * TESTPAT: Separator of field-name and field-body is now not special. * ew-data.el (ew-special-frag-p): Separator of field-name and field-body is now not special. * ew-line.el (ew-cut-generic): New function. (ew-cut-cr-lf): Use `ew-cut-generic'. (ew-cut-cr): New function. (ew-cut-lf): New function. (ew-crlf-line-generic): Renamed from `ew-line-generic' (ew-crlf-line-convert): Renamed from `ew-line-convert' (ew-lf-line-generic): New function. (ew-lf-line-convert): New function. * eword-decode.el (eword-decode-and-fold-structured-field): Use `ew-decode-field'. (eword-decode-and-unfold-structured-field): Use `ew-decode-field'. --- diff --git a/ChangeLog b/ChangeLog index 7ce57ce..cbd8553 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,26 @@ +1998-08-17 Tanaka Akira + + * DOODLE-TIPS: New file. + + * TESTPAT: Separator of field-name and field-body is now not special. + + * ew-data.el (ew-special-frag-p): Separator of field-name and + field-body is now not special. + + * ew-line.el (ew-cut-generic): New function. + (ew-cut-cr-lf): Use `ew-cut-generic'. + (ew-cut-cr): New function. + (ew-cut-lf): New function. + (ew-crlf-line-generic): Renamed from `ew-line-generic' + (ew-crlf-line-convert): Renamed from `ew-line-convert' + (ew-lf-line-generic): New function. + (ew-lf-line-convert): New function. + + * eword-decode.el (eword-decode-and-fold-structured-field): Use + `ew-decode-field'. + (eword-decode-and-unfold-structured-field): Use + `ew-decode-field'. + 1998-08-16 Tanaka Akira * TESTPAT: Add a driver for `ew-decode-field'. diff --git a/DOODLE-TIPS b/DOODLE-TIPS new file mode 100644 index 0000000..317c478 --- /dev/null +++ b/DOODLE-TIPS @@ -0,0 +1,20 @@ +* You should byte-compile(make). +Because DOODLE uses very complex macro. + +Especialy ew-line.el, ew-scan-m.el, ew-scan-s.el and ew-scan-u.el that are require 'lex. +(lex is scanner generator.) + +* Multiline field-bodies fetched from XOVER is already concatinated, +you should set ew-ignore-76bytes-limit to true. + +(setq gnus-unstructured-field-decoder + (lambda (string) + (let ((ew-ignore-76bytes-limit t)) + (eword-decode-unstructured-field-body + (std11-unfold-string string) + (quote must-unfold))))) + +(setq gnus-structured-field-decoder + (lambda (string) + (let ((ew-ignore-76bytes-limit t)) + (eword-decode-and-unfold-structured-field string)))) diff --git a/TESTPAT b/TESTPAT index 3c6348f..09b57fc 100644 --- a/TESTPAT +++ b/TESTPAT @@ -479,7 +479,7 @@ (decode "From:=?ISO-2022-JP?B?GyRCJCIbKEI=?= " -"From:=?ISO-2022-JP?B?GyRCJCIbKEI=?= ") +"From:あ ") (decode "From: akr@jaist.ac.jp\r diff --git a/ew-data.el b/ew-data.el index e45f9d7..612adbb 100644 --- a/ew-data.el +++ b/ew-data.el @@ -121,18 +121,17 @@ ew:raw-cm-qpair-tok))) (defun ew-special-frag-p (frag) - (or (eq frag (get frag 'anchor)) - (member (get frag 'type) - '(ew:raw-lt-tok - ew:raw-gt-tok - ew:raw-at-tok - ew:raw-comma-tok - ew:raw-semicolon-tok - ew:raw-colon-tok - ew:raw-dot-tok - ew:raw-qs-begin-tok - ew:raw-qs-end-tok - ew:raw-dl-begin-tok - ew:raw-dl-end-tok - ew:raw-cm-begin-tok - ew:raw-cm-end-tok)))) + (member (get frag 'type) + '(ew:raw-lt-tok + ew:raw-gt-tok + ew:raw-at-tok + ew:raw-comma-tok + ew:raw-semicolon-tok + ew:raw-colon-tok + ew:raw-dot-tok + ew:raw-qs-begin-tok + ew:raw-qs-end-tok + ew:raw-dl-begin-tok + ew:raw-dl-end-tok + ew:raw-cm-begin-tok + ew:raw-cm-end-tok))) diff --git a/ew-line.el b/ew-line.el index c12bced..c23132c 100644 --- a/ew-line.el +++ b/ew-line.el @@ -2,8 +2,10 @@ (require 'ew-util) (provide 'ew-line) -(put 'ew-line-generic 'lisp-indent-function 1) -(put 'ew-line-convert 'lisp-indent-function 1) +(put 'ew-crlf-line-generic 'lisp-indent-function 1) +(put 'ew-crlf-line-convert 'lisp-indent-function 1) +(put 'ew-lf-line-generic 'lisp-indent-function 1) +(put 'ew-lf-line-convert 'lisp-indent-function 1) (defun ew-lf-to-crlf (str) (let ((i 0) (j 0) (l (length str)) result) @@ -94,10 +96,10 @@ (substring str i)))) (apply 'concat (nreverse result)))) -(defun ew-cut-cr-lf (str) +(defun ew-cut-generic (str chars) (let ((i 0) (j 0) (l (length str)) result) (while (< j l) - (when (member (aref str j) '(?\r ?\n)) + (when (member (aref str j) chars) (setq result (ew-rcons* result (substring str i j)) @@ -109,7 +111,11 @@ (substring str i)))) (apply 'concat (nreverse result)))) -(defmacro ew-line-generic-define () +(defun ew-cut-cr-lf (str) (ew-cut-generic str '(?\r ?\n))) +(defun ew-cut-cr (str) (ew-cut-generic str '(?\r))) +(defun ew-cut-lf (str) (ew-cut-generic str '(?\n))) + +(defmacro ew-crlf-line-generic-define () (let ((str (make-symbol "str")) (others-fun (make-symbol "others-fun")) (fold-fun (make-symbol "fold-fun")) @@ -119,7 +125,7 @@ (p (make-symbol "p")) (q (make-symbol "q")) (r (make-symbol "r"))) - `(defun ew-line-generic + `(defun ew-crlf-line-generic (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun) (let ((,p 0) (,q (length ,str)) ,r) (while (< ,p ,q) @@ -133,9 +139,9 @@ (() (error "something wrong")))) ,q)))) -(ew-line-generic-define) +(ew-crlf-line-generic-define) -(defmacro ew-line-convert-define () +(defmacro ew-crlf-line-convert-define () (let ((str (make-symbol "str")) (others-fun (make-symbol "others-fun")) (fold-fun (make-symbol "fold-fun")) @@ -146,10 +152,10 @@ (result (make-symbol "result")) (start (make-symbol "starx")) (end (make-symbol "end"))) - `(defun ew-line-convert + `(defun ew-crlf-line-convert (,str ,others-fun ,fold-fun ,crlf-fun ,bare-cr-fun ,bare-lf-fun) (let ((,index 0) ,result) - (when (> (ew-line-generic + (when (> (ew-crlf-line-generic ,str ,@(mapcar (lambda (fun) @@ -171,4 +177,62 @@ (substring ,str ,index)))) (apply 'concat (nreverse ,result)))))) -(ew-line-convert-define) +(ew-crlf-line-convert-define) + +(defmacro ew-lf-line-generic-define () + (let ((str (make-symbol "str")) + (others-fun (make-symbol "others-fun")) + (fold-fun (make-symbol "fold-fun")) + (lf-fun (make-symbol "lf-fun")) + (p (make-symbol "p")) + (q (make-symbol "q")) + (r (make-symbol "r"))) + `(defun ew-lf-line-generic + (,str ,others-fun ,fold-fun ,lf-fun) + (let ((,p 0) (,q (length ,str)) ,r) + (while (< ,p ,q) + (setq ,r ,p) + (lex-scan-unibyte ,str ,p ,q + ((+ [^ "\n"]) (when ,others-fun (funcall ,others-fun ,r ,p))) + ((?\n [" \t"]) (when ,fold-fun (funcall ,fold-fun ,r ,p))) + ((?\n) (when ,lf-fun (funcall ,lf-fun ,r ,p))) + (() (error "something wrong")))) + ,q)))) + +(ew-lf-line-generic-define) + +(defmacro ew-lf-line-convert-define () + (let ((str (make-symbol "str")) + (others-fun (make-symbol "others-fun")) + (fold-fun (make-symbol "fold-fun")) + (lf-fun (make-symbol "lf-fun")) + (index (make-symbol "index")) + (result (make-symbol "result")) + (start (make-symbol "starx")) + (end (make-symbol "end"))) + `(defun ew-lf-line-convert + (,str ,others-fun ,fold-fun ,lf-fun) + (let ((,index 0) ,result) + (when (> (ew-lf-line-generic + ,str + ,@(mapcar + (lambda (fun) + `(when ,fun + (lambda (,start ,end) + (when (< ,index ,start) + (setq ,result + (ew-rcons* ,result + (substring ,str ,index ,start)))) + (setq ,result + (ew-rcons* ,result + (funcall ,fun + (substring ,str ,start ,end))) + ,index ,end)))) + (list others-fun fold-fun lf-fun))) + ,index) + (setq ,result + (ew-rcons* ,result + (substring ,str ,index)))) + (apply 'concat (nreverse ,result)))))) + +(ew-lf-line-convert-define) diff --git a/eword-decode.el b/eword-decode.el index 180559e..fa1d5a0 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -712,32 +712,34 @@ such as a version of Net$cape)." (list string start-column max-column must-unfold)) (or max-column (setq max-column fill-column)) - (let ((c start-column) - (tokens (eword-lexical-analyze string must-unfold)) - (result "") - token) - (while (and (setq token (car tokens)) - (setq tokens (cdr tokens))) - (let* ((type (car token))) - (if (eq type 'spaces) - (let* ((next-token (car tokens)) - (next-str (eword-decode-token next-token)) - (next-len (string-width next-str)) - (next-c (+ c next-len 1))) - (if (< next-c max-column) - (setq result (concat result " " next-str) - c next-c) - (setq result (concat result "\n " next-str) - c (1+ next-len))) - (setq tokens (cdr tokens)) - ) - (let* ((str (eword-decode-token token))) - (setq result (concat result str) - c (+ c (string-width str))) - )))) - (if token - (concat result (eword-decode-token token)) - result))) + (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) + (decoded (ew-decode-field (make-string (1- start-column) ?X) + (ew-lf-crlf-to-crlf string) + (if must-unfold 'ew-cut-cr-lf))) + column) + (setq decoded (ew-crlf-to-lf decoded)) + (setq column 0) + (ew-lf-line-convert decoded + (lambda (line) + (if (<= (length line) max-column) + line + (let ((start 0) index) + (catch 'loop + (while (< (+ column start) max-column) + (if (string-match " " decoded start) + (progn + (setq start (match-end 0)) + (when (< (match-beginning 0) max-column) + (setq index (match-beginning 0)))) + (throw 'loop nil))) + (setq index (string-match " " decoded start))) + (if index + (concat (substring decoded 0 index) + "\n" + (substring decoded index)) + decoded)))) + (lambda (str) (setq column 1) str) + (lambda (str) (setq column 0) str)))) (defun eword-decode-and-unfold-structured-field (string) "Decode and unfold STRING as structured field body. @@ -749,18 +751,11 @@ If an encoded-word is broken or your emacs implementation can not decode the charset included in it, it is not decoded." (rotate-memo args-eword-decode-and-unfold-structured-field (list string)) - (let ((tokens (eword-lexical-analyze string 'must-unfold)) - (result "")) - (while tokens - (let* ((token (car tokens)) - (type (car token))) - (setq tokens (cdr tokens)) - (setq result - (if (eq type 'spaces) - (concat result " ") - (concat result (eword-decode-token token)) - )))) - result)) + (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) + (decoded (ew-decode-field "" + (ew-lf-crlf-to-crlf string) + 'ew-cut-cr-lf))) + (ew-cut-cr-lf decoded))) (defun eword-decode-structured-field-body (string &optional must-unfold start-column max-column)