X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel-q.el;h=0e80c169c27c4b308e9833d7af357dbdbc75b4c5;hb=733c8dc5119f2b5df1fb571d0882c5f4350f21d5;hp=6ec4f0b983aadc53962a1d8e6c16711cdca6bd03;hpb=220912d69dfb1f7cc158dc1e4a1a17a560a75ba6;p=elisp%2Fflim.git diff --git a/mel-q.el b/mel-q.el index 6ec4f0b..0e80c16 100644 --- a/mel-q.el +++ b/mel-q.el @@ -44,19 +44,18 @@ (save-restriction (narrow-to-region start end) (goto-char start) - (let ((col 0) - enable-multibyte-characters) + (let ((col 0)) (while (< (point)(point-max)) (cond ((>= col 75) (insert "=\n") (setq col 0) ) - ((looking-at "^From ") + ((looking-at-as-unibyte "^From ") (replace-match "=46rom ") (backward-char 1) (setq col (+ col 6)) ) - ((looking-at "[ \t]\n") + ((looking-at-as-unibyte "[ \t]\n") (forward-char 1) (insert "=\n") (forward-char 1) @@ -145,7 +144,16 @@ the program (maybe mmencode included in metamail or XEmacs package)." )) -(defun quoted-printable-insert-encoded-file (filename) +(mel-define-method-function + (mime-encode-string string (nil "quoted-printable")) + 'quoted-printable-encode-string) + +(mel-define-method-function + (mime-encode-region start end (nil "quoted-printable")) + 'quoted-printable-encode-region) + +(mel-define-method mime-insert-encoded-file (filename + (nil "quoted-printable")) "Encode contents of file FILENAME to quoted-printable, and insert the result. It calls external quoted-printable encoder specified by `quoted-printable-external-encoder'. So you must install the program @@ -159,53 +167,37 @@ It calls external quoted-printable encoder specified by ;;; @ Quoted-Printable decoder ;;; -(defun quoted-printable-decode-string (string) - "Decode STRING which is encoded in quoted-printable, and return the result." - (let (q h l) - (mapconcat (function - (lambda (chr) - (cond ((eq chr ?=) - (setq q t) - "") - (q (setq h - (cond ((<= ?a chr) (+ (- chr ?a) 10)) - ((<= ?A chr) (+ (- chr ?A) 10)) - ((<= ?0 chr) (- chr ?0)) - )) - (setq q nil) - "") - (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10)) - ((<= ?A chr) (+ (- chr ?A) 10)) - ((<= ?0 chr) (- chr ?0)) - )) - (prog1 - (char-to-string (logior (ash h 4) l)) - (setq h nil) - ) - ) - (t (char-to-string chr)) - ))) - string ""))) +(defsubst quoted-printable-hex-char-to-num (chr) + (cond ((<= ?a chr) (+ (- chr ?a) 10)) + ((<= ?A chr) (+ (- chr ?A) 10)) + ((<= ?0 chr) (- chr ?0)) + )) (defun quoted-printable-internal-decode-region (start end) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (while (re-search-forward "=\n" nil t) - (replace-match "") - ) - (goto-char (point-min)) - (let (b e str) - (while (re-search-forward quoted-printable-octet-regexp nil t) - (setq b (match-beginning 0)) - (setq e (match-end 0)) - (setq str (buffer-substring b e)) - (delete-region b e) - (insert (string-as-multibyte (quoted-printable-decode-string str))) - )) - ))) - + (while (search-forward "=" nil t) + (let ((beg (match-beginning 0))) + (cond ((looking-at "\n") + (delete-region beg (match-end 0)) + ) + ((looking-at + `,(concat "[" quoted-printable-hex-chars + "][" quoted-printable-hex-chars "]")) + (let* ((end (match-end 0)) + (hex (buffer-substring (match-beginning 0) end))) + (delete-region beg end) + (insert + (logior + (ash (quoted-printable-hex-char-to-num (aref hex 0)) 4) + (quoted-printable-hex-char-to-num (aref hex 1)))) + )) + (t + ;; invalid + )) + ))))) (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u") "*list of quoted-printable decoder program name and its arguments.") @@ -239,11 +231,28 @@ the program (maybe mmencode included in metamail or XEmacs package)." (quoted-printable-internal-decode-region start end) )) +(defun quoted-printable-decode-string (string) + "Decode STRING which is encoded in quoted-printable, and return the result." + (with-temp-buffer + (insert string) + (quoted-printable-decode-region (point-min)(point-max)) + (buffer-string))) + + +(mel-define-method-function + (mime-decode-string string (nil "quoted-printable")) + 'quoted-printable-decode-string) + +(mel-define-method-function + (mime-decode-region start end (nil "quoted-printable")) + 'quoted-printable-decode-region) + (defvar quoted-printable-external-decoder-option-to-specify-file '("-o") "*list of options of quoted-printable decoder program to specify file.") -(defun quoted-printable-write-decoded-region (start end filename) +(mel-define-method mime-write-decoded-region (start end filename + (nil "quoted-printable")) "Decode and write current region encoded by quoted-printable into FILENAME. START and END are buffer positions." (interactive @@ -300,16 +309,10 @@ MODE allows `text', `comment', `phrase' or nil. Default value is ((eq chr ?=) (setq q t) "") - (q (setq h (cond ((<= ?a chr) (+ (- chr ?a) 10)) - ((<= ?A chr) (+ (- chr ?A) 10)) - ((<= ?0 chr) (- chr ?0)) - )) + (q (setq h (quoted-printable-hex-char-to-num chr)) (setq q nil) "") - (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10)) - ((<= ?A chr) (+ (- chr ?A) 10)) - ((<= ?0 chr) (- chr ?0)) - )) + (h (setq l (quoted-printable-hex-char-to-num chr)) (prog1 (char-to-string (logior (ash h 4) l)) (setq h nil) @@ -319,31 +322,14 @@ MODE allows `text', `comment', `phrase' or nil. Default value is ))) string ""))) +(mel-define-method-function (encoded-text-encode-string string (nil "Q")) + 'q-encoding-encode-string) -;;; @@ etc -;;; - -(defun q-encoding-printable-char-p (chr mode) - (and (not (memq chr '(?= ?? ?_))) - (<= ?\ chr)(<= chr ?~) - (cond ((eq mode 'text) t) - ((eq mode 'comment) - (not (memq chr '(?\( ?\) ?\\))) - ) - (t - (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)) - )))) - -(defun q-encoding-encoded-length (string &optional mode) - (let ((l 0)(i 0)(len (length string)) chr) - (while (< i len) - (setq chr (elt string i)) - (if (q-encoding-printable-char-p chr mode) - (setq l (+ l 1)) - (setq l (+ l 3)) - ) - (setq i (+ i 1)) ) - l)) +(mel-define-method encoded-text-decode-string (string (nil "Q")) + (if (and (string-match Q-encoded-text-regexp string) + (string= string (match-string 0 string))) + (q-encoding-decode-string string) + (error "Invalid encoded-text %s" string))) ;;; @ end