From 229cf501d736fdecd2dc0aae3769200c14408efe Mon Sep 17 00:00:00 2001 From: morioka Date: Sat, 10 Oct 1998 05:51:15 +0000 Subject: [PATCH] Sync up with flim-1_10_3. --- ChangeLog | 55 +++++++++++ FLIM-CFG | 1 + FLIM-VERSION | 3 +- Makefile | 4 +- eword-decode.el | 278 +++++++++++++++++++++++++++++-------------------------- mel-b-dl.el | 29 +++--- mel-b.el | 55 ++++++++--- mel-ccl.el | 7 +- mime-def.el | 2 +- 9 files changed, 267 insertions(+), 167 deletions(-) diff --git a/ChangeLog b/ChangeLog index d238029..ea15e85 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,58 @@ +1998-10-10 MORIOKA Tomohiko + + * mel-ccl.el (base64-ccl-write-decoded-region): bind + `jka-compr-compression-info-list' with nil. + + * mel-b.el (base64-internal-decoding-limit): Switch default value + between XEmacs-mule and other emacsen. + Abolish function `base64-decode-string!'. + (base64-internal-decode-region): New implementation. + (base64-insert-encoded-file): New function. + (mime-insert-encoded-file): Use `base64-insert-encoded-file'. + (base64-write-decoded-region): New function. + (mime-write-decoded-region): Use `base64-write-decoded-region'. + + * mel-b-dl.el (decode-base64-region): Renamed from + `base64-decode-region'. + (mime-insert-encoded-file): Change temporary-buffer to unibyte + representation. Abolish method `mime-write-decoded-region' + because it is slower than CCL based implementation. + +1998-10-09 Tanaka Akira + + * mel-ccl.el: Check `ccl-execute-eof-block-on-decoding-some' + facility instead of `ccl-execute-eof-block-on-encoding-some'. + +1998-10-09 MORIOKA Tomohiko + + * mel-b.el (base64-characters): Enclose with `eval-and-compile'. + + * eword-decode.el (eword-encoded-text-regexp): Enclose with + `eval-and-compile'. + (eword-encoded-word-regexp): Use `eval-when-compile'. + +1998-10-09 MORIOKA Tomohiko + + * eword-decode.el (eword-max-size-to-decode): New user option. + (eword-decode-and-fold-structured-field): Do nothing if size of + input is bigger than `eword-max-size-to-decode'. + +1998-10-08 MORIOKA Tomohiko + + * mel-b.el (base64-numbers): Use `eval-when-compile'. + +1998-10-09 Katsumi Yamaoka + + * FLIM-CFG: Use `add-latest-path' instead of `add-path' for adding + "custom" to load-path. + +1998-10-09 Katsumi Yamaoka + + * mime-def.el (mime-library-product): Enclose with + `eval-and-compile'. + + * FLIM-CFG: Add "custom" to load-path. + 1998-10-08 MORIOKA Tomohiko * mime-def.el, mel.el, mel-b-dl.el: Move variable diff --git a/FLIM-CFG b/FLIM-CFG index 37ddd2a..894af45 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -18,6 +18,7 @@ (require 'install) +(add-latest-path "custom") (add-path default-directory) (or (fboundp 'write-region-as-binary) diff --git a/FLIM-VERSION b/FLIM-VERSION index 4346ba7..1dfc351 100644 --- a/FLIM-VERSION +++ b/FLIM-VERSION @@ -25,7 +25,7 @@ 1.10.0 K-Dòdo-A $(B6=8M(B 1.10.1 Miyamaki $(B;0;3LZ(B 1.10.2 Kintetsu-Miyazu $(B6aE45\DE(B ------ Komada $(B9}ED(B +1.10.3 Komada $(B9}ED(B ----- Shin-H-Dòsono-A $(B?7=K1`(B ; <=> JR $(BJRD.@~(B $(B=K1`(B ----- Kizugawadai $(BLZDE@nBf(B ----- Yamadagawa $(B;3ED@n(B @@ -63,3 +63,4 @@ 1.11.0 Imadegawa $(B:#=P@n(B 1.11.1 Kuramaguchi $(B0HGO8}(B 1.11.2 Kita-Dòji-A $(BKLBgO)(B +1.11.3 Kitayama $(BKL;3(B diff --git a/Makefile b/Makefile index 60727b1..5a7cd35 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # PACKAGE = flim-chao -VERSION = 1.11.2 +VERSION = 1.11.3 TAR = tar RM = /bin/rm -f @@ -55,7 +55,7 @@ tar: sed "s/VERSION/$(VERSION)/" < ftp.in > ftp release: - -$(RM) /pub/GNU/elisp/apel/$(PACKAGE)-$(VERSION).tar.gz + -$(RM) /pub/GNU/elisp/flim/$(PACKAGE)-$(VERSION).tar.gz mv /tmp/$(PACKAGE)-$(VERSION).tar.gz /pub/GNU/elisp/flim/ cd /pub/GNU/elisp/semi/ ; \ ln -s ../flim/$(PACKAGE)-$(VERSION).tar.gz . diff --git a/eword-decode.el b/eword-decode.el index b26bf59..2414a7a 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -39,23 +39,32 @@ "Encoded-word decoding" :group 'mime) +(defcustom eword-max-size-to-decode 1000 + "*Max size to decode header field." + :group 'eword-decode + :type '(choice (integer :tag "Limit (bytes)") + (const :tag "Don't limit" nil))) + ;;; @ MIME encoded-word definition ;;; -(defconst eword-encoded-text-regexp "[!->@-~]+") +(eval-and-compile + (defconst eword-encoded-text-regexp "[!->@-~]+") + ) (defconst eword-encoded-word-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-regexp - "\\)" - (regexp-quote "?="))) + (eval-when-compile + (concat (regexp-quote "=?") + "\\(" + mime-charset-regexp + "\\)" + (regexp-quote "?") + "\\(B\\|Q\\)" + (regexp-quote "?") + "\\(" + eword-encoded-text-regexp + "\\)" + (regexp-quote "?=")))) ;;; @ for string @@ -98,6 +107,130 @@ such as a version of Net$cape)." (concat dest string) )) +(defun eword-decode-and-fold-structured-field + (string start-column &optional max-column must-unfold) + "Decode and fold (fill) 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 +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. + +If MAX-COLUMN is omitted, `fill-column' is used. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (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)) + (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)))) + +(defun eword-decode-and-unfold-structured-field (string) + "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 +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)) + (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)) + +(defun eword-decode-structured-field-body (string &optional must-unfold + start-column max-column) + "Decode non us-ascii characters in STRING as structured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +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. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (if start-column + ;; fold with max-column + (eword-decode-and-fold-structured-field + string start-column max-column must-unfold) + ;; Don't fold + (mapconcat (function eword-decode-token) + (eword-lexical-analyze string must-unfold) + "") + )) + +(defun eword-decode-unstructured-field-body (string &optional must-unfold) + "Decode non us-ascii characters in STRING as unstructured field body. +STRING is unfolded before decoding. + +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +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. + +If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (eword-decode-string + (decode-mime-charset-string string default-mime-charset) + must-unfold)) + +(defun eword-decode-and-unfold-unstructured-field (string) + "Decode and unfold STRING as unstructured field body. +It decodes non us-ascii characters in FULL-NAME encoded as +encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii +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." + (eword-decode-string + (decode-mime-charset-string (std11-unfold-string string) + default-mime-charset) + 'must-unfold)) + ;;; @ for region ;;; @@ -439,127 +572,6 @@ characters encoded as encoded-words or invalid \"raw\" format. (concat "(" (std11-wrap-as-quoted-pairs value '(?( ?))) ")")) (t value)))) -(defun eword-decode-and-fold-structured-field - (string start-column &optional max-column must-unfold) - "Decode and fold (fill) 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 -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. - -If MAX-COLUMN is omitted, `fill-column' is used. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (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))) - -(defun eword-decode-and-unfold-structured-field (string) - "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 -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)) - (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)) - -(defun eword-decode-structured-field-body (string &optional must-unfold - start-column max-column) - "Decode non us-ascii characters in STRING as structured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -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. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (if start-column - ;; fold with max-column - (eword-decode-and-fold-structured-field - string start-column max-column must-unfold) - ;; Don't fold - (mapconcat (function eword-decode-token) - (eword-lexical-analyze string must-unfold) - "") - )) - -(defun eword-decode-unstructured-field-body (string &optional must-unfold) - "Decode non us-ascii characters in STRING as unstructured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -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. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (eword-decode-string - (decode-mime-charset-string string default-mime-charset) - must-unfold)) - -(defun eword-decode-and-unfold-unstructured-field (string) - "Decode and unfold STRING as unstructured field body. -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -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." - (eword-decode-string - (decode-mime-charset-string (std11-unfold-string string) - default-mime-charset) - 'must-unfold)) - (defun eword-extract-address-components (string) "Extract full name and canonical address from STRING. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). diff --git a/mel-b-dl.el b/mel-b-dl.el index 0f0f22e..3adea3d 100644 --- a/mel-b-dl.el +++ b/mel-b-dl.el @@ -47,7 +47,7 @@ START and END are buffer positions." (insert "\n")) ) -(defun base64-decode-region (start end) +(defun decode-base64-region (start end) "Decode current region by base64. START and END are buffer positions." (interactive "r") @@ -69,7 +69,7 @@ START and END are buffer positions." (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-encode-region) (mel-define-method-function (mime-decode-region start end (nil "base64")) - 'base64-decode-region) + 'decode-base64-region) (mel-define-method-function (encoded-text-encode-string string (nil "B")) 'encode-base64-string) @@ -92,24 +92,25 @@ mmencode included in metamail or XEmacs package)." (interactive (list (read-file-name "Insert encoded file: "))) (insert (encode-base64-string (with-temp-buffer + (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)))) (or (bolp) (insert "\n")) ) -(mel-define-method mime-write-decoded-region (start end filename - (nil "base64")) - "Decode and write current region encoded by base64 into FILENAME. -START and END are buffer positions." - (interactive - (list (region-beginning) (region-end) - (read-file-name "Write decoded region to file: "))) - (let ((str (buffer-substring start end))) - (with-temp-buffer - (insert (decode-base64-string str)) - (write-region-as-binary (point-min) (point-max) filename) - ))) +;; (mel-define-method mime-write-decoded-region (start end filename +;; (nil "base64")) +;; "Decode and write current region encoded by base64 into FILENAME. +;; START and END are buffer positions." +;; (interactive +;; (list (region-beginning) (region-end) +;; (read-file-name "Write decoded region to file: "))) +;; (let ((str (buffer-substring start end))) +;; (with-temp-buffer +;; (insert (decode-base64-string str)) +;; (write-region-as-binary (point-min) (point-max) filename) +;; ))) ;;; @ end diff --git a/mel-b.el b/mel-b.el index deb54ff..ad34a37 100644 --- a/mel-b.el +++ b/mel-b.el @@ -60,7 +60,10 @@ external encoder is called." :type '(choice (const :tag "Always use internal encoder" nil) (integer :tag "Size"))) -(defcustom base64-internal-decoding-limit 70000 +(defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs) + (featurep 'mule)) + 1000 + 7600) "*limit size to use internal base64 decoder. If size of input to decode is larger than this limit, external decoder is called." @@ -72,8 +75,10 @@ external decoder is called." ;;; @ internal base64 encoder ;;; based on base64 decoder by Enami Tsugutomo -(defconst base64-characters - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") +(eval-and-compile + (defconst base64-characters + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") + ) (defmacro base64-num-to-char (n) `(aref base64-characters ,n)) @@ -147,13 +152,14 @@ external decoder is called." ;;; (defconst base64-numbers - `,(let ((len (length base64-characters)) + (eval-when-compile + (let ((len (length base64-characters)) (vec (make-vector 123 nil)) (i 0)) (while (< i len) (aset vec (aref base64-characters i) i) (setq i (1+ i))) - vec)) + vec))) (defmacro base64-char-to-num (c) `(aref base64-numbers ,c)) @@ -191,15 +197,30 @@ external decoder is called." (defun base64-internal-decode-string (string) (base64-internal-decode string (make-string (length string) 0))) -(defsubst base64-decode-string! (string) - (base64-internal-decode string string)) +;; (defsubst base64-decode-string! (string) +;; (setq string (string-as-unibyte string)) +;; (base64-internal-decode string string)) (defun base64-internal-decode-region (beg end) (save-excursion - (let ((str (buffer-substring beg end))) + (let ((str (string-as-unibyte (buffer-substring beg end)))) (delete-region beg end) (goto-char beg) - (insert (base64-decode-string! str))))) + (insert (base64-internal-decode str str))))) + +;; (defun base64-internal-decode-region2 (beg end) +;; (save-excursion +;; (let ((str (buffer-substring beg end))) +;; (delete-region beg end) +;; (goto-char beg) +;; (insert (base64-decode-string! str))))) + +;; (defun base64-internal-decode-region3 (beg end) +;; (save-excursion +;; (let ((str (buffer-substring beg end))) +;; (delete-region beg end) +;; (goto-char beg) +;; (insert (base64-internal-decode-string str))))) ;;; @ external encoder/decoder @@ -302,7 +323,7 @@ metamail or XEmacs package)." (base64-decode-string string) (error "Invalid encoded-text %s" string))) -(mel-define-method mime-insert-encoded-file (filename (nil "base64")) +(defun base64-insert-encoded-file (filename) "Encode contents of file FILENAME to base64, and insert the result. It calls external base64 encoder specified by `base64-external-encoder'. So you must install the program (maybe @@ -316,14 +337,17 @@ mmencode included in metamail or XEmacs package)." (insert (base64-encode-string (with-temp-buffer + (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)))) (or (bolp) (insert "\n")) )) -(mel-define-method mime-write-decoded-region (start end filename - (nil "base64")) +(mel-define-method-function (mime-insert-encoded-file filename (nil "base64")) + 'base64-insert-encoded-file) + +(defun base64-write-decoded-region (start end filename) "Decode and write current region encoded by base64 into FILENAME. START and END are buffer positions." (interactive @@ -341,7 +365,12 @@ START and END are buffer positions." (let ((str (buffer-substring start end))) (with-temp-buffer (insert (base64-internal-decode-string str)) - (write-region-as-binary (point-min) (point-max) filename))))) + (write-region-as-binary (point-min) (point-max) filename) + )))) + +(mel-define-method-function + (mime-write-decoded-region start end filename (nil "base64")) + 'base64-write-decoded-region) ;;; @ etc diff --git a/mel-ccl.el b/mel-ccl.el index e50ad5f..12b18e1 100644 --- a/mel-ccl.el +++ b/mel-ccl.el @@ -1173,7 +1173,7 @@ abcdefghijklmnopqrstuvwxyz\ ;;; @ B ;;; -(unless-broken ccl-execute-eof-block-on-encoding-some +(unless-broken ccl-execute-eof-block-on-decoding-some (defun base64-ccl-encode-string (string) "Encode STRING with base64 encoding." @@ -1216,7 +1216,8 @@ abcdefghijklmnopqrstuvwxyz\ (interactive (list (region-beginning) (region-end) (read-file-name "Write decoded region to file: "))) - (let ((coding-system-for-write 'mel-ccl-b-rev)) + (let ((coding-system-for-write 'mel-ccl-b-rev) + jka-compr-compression-info-list) (write-region start end filename))) (mel-define-method-function (mime-decode-string string (nil "base64")) @@ -1237,7 +1238,7 @@ abcdefghijklmnopqrstuvwxyz\ ;;; @ quoted-printable ;;; -(unless-broken ccl-execute-eof-block-on-encoding-some +(unless-broken ccl-execute-eof-block-on-decoding-some (defun quoted-printable-ccl-encode-string (string) "Encode STRING with quoted-printable encoding." diff --git a/mime-def.el b/mime-def.el index bb72e4d..5883b7e 100644 --- a/mime-def.el +++ b/mime-def.el @@ -24,7 +24,7 @@ ;;; Code: -(defconst mime-library-product ["Chao" (1 11 2) "Kita.DŽòji"] +(defconst mime-library-product ["Chao" (1 11 3) "Kitayama"] "Product name, version number and code name of MIME-library package.") (defmacro mime-product-name (product) -- 1.7.10.4