X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fqp.el;h=6c48f0fc9a45ace1c4d2965c873062fc191b555b;hb=80adb645d1b56d7f2c28700a174052b5758ea015;hp=b2f1c2bffd19f9e4cd7a59729a1235f557e36fec;hpb=d25c4dca6c60734e3fcd29b4057c7913e6360b65;p=gnus diff --git a/lisp/qp.el b/lisp/qp.el index b2f1c2bff..6c48f0fc9 100644 --- a/lisp/qp.el +++ b/lisp/qp.el @@ -1,26 +1,24 @@ ;;; qp.el --- Quoted-Printable functions -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, extensions ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,13 +28,23 @@ ;;; Code: (require 'mm-util) -(eval-when-compile (defvar mm-use-ultra-safe-encoding)) +(defvar mm-use-ultra-safe-encoding) +;;;###autoload (defun quoted-printable-decode-region (from to &optional coding-system) "Decode quoted-printable in the region between FROM and TO, per RFC 2045. If CODING-SYSTEM is non-nil, decode bytes into characters with that -coding-system." - (interactive "r") +coding-system. + +Interactively, you can supply the CODING-SYSTEM argument +with \\[universal-coding-system-argument]. + +The CODING-SYSTEM argument is a historical hangover and is deprecated. +QP encodes raw bytes and should be decoded into raw bytes. Decoding +them into characters should be done separately." + (interactive + ;; Let the user determine the coding system with "C-x RET c". + (list (region-beginning) (region-end) coding-system-for-read)) (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus (setq coding-system nil)) (save-excursion @@ -53,28 +61,40 @@ coding-system." (if coding-system (mm-encode-coding-region (point-min) (point-max) coding-system)) (goto-char (point-min)) - (while (and (skip-chars-forward "^=" to) + (while (and (skip-chars-forward "^=") (not (eobp))) (cond ((eq (char-after (1+ (point))) ?\n) (delete-char 2)) - ((looking-at "=[0-9A-F][0-9A-F]") - (let ((byte (string-to-int (buffer-substring (1+ (point)) - (+ 3 (point))) - 16))) - (insert byte) - (delete-char 3) - (unless (eq byte ?=) - (backward-char)))) + ((looking-at "\\(=[0-9A-F][0-9A-F]\\)+") + ;; Decode this sequence at once; i.e. by a single + ;; deletion and insertion. + (let* ((n (/ (- (match-end 0) (point)) 3)) + (str (make-string n 0))) + (dotimes (i n) + (let ((n1 (char-after (1+ (point)))) + (n2 (char-after (+ 2 (point))))) + (aset str i + (+ (* 16 (- n1 (if (<= n1 ?9) ?0 + (if (<= n1 ?F) (- ?A 10) + (- ?a 10))))) + (- n2 (if (<= n2 ?9) ?0 + (if (<= n2 ?F) (- ?A 10) + (- ?a 10))))))) + (forward-char 3)) + (delete-region (match-beginning 0) (match-end 0)) + (insert str))) (t - (error "Malformed quoted-printable text") + (message "Malformed quoted-printable text") (forward-char))))) (if coding-system (mm-decode-coding-region (point-min) (point-max) coding-system))))) (defun quoted-printable-decode-string (string &optional coding-system) "Decode the quoted-printable encoded STRING and return the result. -If CODING-SYSTEM is non-nil, decode the region with coding-system." - (with-temp-buffer +If CODING-SYSTEM is non-nil, decode the string with coding-system. +Use of CODING-SYSTEM is deprecated; this function should deal with +raw bytes, and coding conversion should be done separately." + (mm-with-unibyte-buffer (insert string) (quoted-printable-decode-region (point-min) (point-max) coding-system) (buffer-string))) @@ -83,8 +103,9 @@ If CODING-SYSTEM is non-nil, decode the region with coding-system." "Quoted-printable encode the region between FROM and TO per RFC 2045. If FOLD, fold long lines at 76 characters (as required by the RFC). -If CLASS is non-nil, translate the characters matched by that class in -the form expected by `skip-chars-forward'. +If CLASS is non-nil, translate the characters not matched by that +regexp class, which is in the form expected by `skip-chars-forward'. +You should probably avoid non-ASCII characters in this arg. If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and encode lines starting with \"From\"." @@ -93,66 +114,61 @@ encode lines starting with \"From\"." ;; Avoid using 8bit characters. = is \075. ;; Equivalent to "^\000-\007\013\015-\037\200-\377=" (setq class "\010-\012\014\040-\074\076-\177")) - (if (fboundp 'string-as-multibyte) - (setq class (string-as-multibyte class))) (save-excursion + (goto-char from) + (if (re-search-forward (mm-string-to-multibyte "[^\x0-\x7f\x80-\xff]") + to t) + (error "Multibyte character in QP encoding region")) (save-restriction (narrow-to-region from to) - (mm-with-unibyte-current-buffer-mule4 - ;; Fixme: what should this do in XEmacs/Mule? - (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule - (if (delq 'unknown ; Emacs 20 unibyte - (delq 'eight-bit-graphic ; Emacs 21 - (delq 'eight-bit-control - (delq 'ascii - (find-charset-region from to))))) - (error "Multibyte character in QP encoding region"))) - ;; Encode all the non-ascii and control characters. - (goto-char (point-min)) - (while (and (skip-chars-forward class) - (not (eobp))) + ;; Encode all the non-ascii and control characters. + (goto-char (point-min)) + (while (and (skip-chars-forward class) + (not (eobp))) + (insert + (prog1 + ;; To unibyte in case of Emacs 23 (unicode) eight-bit. + (format "=%02X" (mm-multibyte-char-to-unibyte (char-after))) + (delete-char 1)))) + ;; Encode white space at the end of lines. + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" nil t) + (goto-char (match-beginning 0)) + (while (not (eolp)) (insert (prog1 (format "=%02X" (char-after)) - (delete-char 1)))) - ;; Encode white space at the end of lines. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" nil t) - (goto-char (match-beginning 0)) - (while (not (eolp)) - (insert - (prog1 - (format "=%02X" (char-after)) - (delete-char 1))))) - (let ((mm-use-ultra-safe-encoding - (and (boundp 'mm-use-ultra-safe-encoding) - mm-use-ultra-safe-encoding))) - (when (or fold mm-use-ultra-safe-encoding) - ;; Fold long lines. - (let ((tab-width 1)) ; HTAB is one character. - (goto-char (point-min)) - (while (not (eobp)) - ;; In ultra-safe mode, encode "From " at the beginning - ;; of a line. - (when mm-use-ultra-safe-encoding - (beginning-of-line) - (if (looking-at "From ") - (replace-match "From=20" nil t) - (if (looking-at "-") - (replace-match "=2D" nil t)))) - (end-of-line) + (delete-char 1))))) + (let ((mm-use-ultra-safe-encoding + (and (boundp 'mm-use-ultra-safe-encoding) + mm-use-ultra-safe-encoding))) + (when (or fold mm-use-ultra-safe-encoding) + (let ((tab-width 1)) ; HTAB is one character. + (goto-char (point-min)) + (while (not (eobp)) + ;; In ultra-safe mode, encode "From " at the beginning + ;; of a line. + (when mm-use-ultra-safe-encoding + (if (looking-at "From ") + (replace-match "From=20" nil t) + (if (looking-at "-") + (replace-match "=2D" nil t)))) + (end-of-line) + ;; Fold long lines. (while (> (current-column) 76) ; tab-width must be 1. (beginning-of-line) (forward-char 75) ; 75 chars plus an "=" (search-backward "=" (- (point) 2) t) (insert "=\n") (end-of-line)) - (unless (eobp) - (forward-line)))))))))) - + (forward-line)))))))) + (defun quoted-printable-encode-string (string) "Encode the STRING as quoted-printable and return the result." (with-temp-buffer + (if (mm-multibyte-string-p string) + (mm-enable-multibyte) + (mm-disable-multibyte)) (insert string) (quoted-printable-encode-region (point-min) (point-max)) (buffer-string)))