[bpt/emacs.git] / lisp / gnus / qp.el

;;; qp.el --- Quoted-Printable functions

;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, extensions

;; This file is part of GNU Emacs.

;; 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.

;; 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
;; 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.

;;; Commentary:

;; Functions for encoding and decoding quoted-printable text as
;; defined in RFC 2045.

;;; Code:

(require 'mm-util)
(eval-when-compile (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.

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
    (save-restriction
      ;; RFC 2045:  ``An "=" followed by two hexadecimal digits, one
      ;; or both of which are lowercase letters in "abcdef", is
      ;; formally illegal. A robust implementation might choose to
      ;; recognize them as the corresponding uppercase letters.''
      (let ((case-fold-search t))
	(narrow-to-region from to)
	;; Do this in case we're called from Gnus, say, in a buffer
	;; which already contains non-ASCII characters which would
	;; then get doubly-decoded below.
	(if coding-system
	    (mm-encode-coding-region (point-min) (point-max) coding-system))
	(goto-char (point-min))
	(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)))
		   (mm-insert-byte byte 1)
		   (delete-char 3)))
		(t
		 (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.
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)))

(defun quoted-printable-encode-region (from to &optional fold class)
  "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 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\"."
  (interactive "r")
  (save-excursion
    (goto-char from)
    (if (fboundp 'string-to-multibyte)	; Emacs 22
	(if (re-search-forward (string-to-multibyte "[^\x0-\x7f\x80-\xff]")
			       to t)
	    ;; Fixme: This is somewhat misleading.
	    (error "Multibyte character in QP encoding region"))
      (if (re-search-forward (mm-string-as-multibyte "[^\0-\377]") to t)
	  (error "Multibyte character in QP encoding region"))))
  (unless class
    ;; Avoid using 8bit characters. = is \075.
    ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
    (setq class "\010-\012\014\040-\074\076-\177"))
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
      ;; 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 22 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)))))
      (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))
	      (forward-line))))))))

(defun quoted-printable-encode-string (string)
  "Encode the STRING as quoted-printable and return the result."
  (let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
    (with-temp-buffer
      (insert string)
      (quoted-printable-encode-region (point-min) (point-max))
      (buffer-string))))

(provide 'qp)

;;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba
;;; qp.el ends here
Commit	Line	Data
c113de23	1	;;; qp.el --- Quoted-Printable functions
657b2c65	2
23f87bed	3	;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
c113de23 GM	4
c113de23 GM	5	;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
657b2c65 DL	6	;; Keywords: mail, extensions
657b2c65 DL	7
c113de23 GM	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
	24
	25	;;; Commentary:
	26
657b2c65 DL	27	;; Functions for encoding and decoding quoted-printable text as
657b2c65 DL	28	;; defined in RFC 2045.
c113de23	29
657b2c65	30	;;; Code:
c113de23	31
b756f5b4 DL	32	(require 'mm-util)
b756f5b4 DL	33	(eval-when-compile (defvar mm-use-ultra-safe-encoding))
d21a76da	34
23f87bed	35	;;;###autoload
d21a76da	36	(defun quoted-printable-decode-region (from to &optional coding-system)
657b2c65	37	"Decode quoted-printable in the region between FROM and TO, per RFC 2045.
d21a76da	38	If CODING-SYSTEM is non-nil, decode bytes into characters with that
5c543a33 SZ	39	coding-system.
	40
	41	Interactively, you can supply the CODING-SYSTEM argument
23f87bed MB	42	with \\[universal-coding-system-argument].
	43
	44	The CODING-SYSTEM argument is a historical hangover and is deprecated.
	45	QP encodes raw bytes and should be decoded into raw bytes. Decoding
	46	them into characters should be done separately."
753b4645 EZ	47	(interactive
	48	;; Let the user determine the coding system with "C-x RET c".
	49	(list (region-beginning) (region-end) coding-system-for-read))
b5287163 DL	50	(unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
b5287163 DL	51	(setq coding-system nil))
c113de23 GM	52	(save-excursion
c113de23 GM	53	(save-restriction
b5287163 DL	54	;; RFC 2045: ``An "=" followed by two hexadecimal digits, one
	55	;; or both of which are lowercase letters in "abcdef", is
	56	;; formally illegal. A robust implementation might choose to
	57	;; recognize them as the corresponding uppercase letters.''
d21a76da	58	(let ((case-fold-search t))
c113de23	59	(narrow-to-region from to)
d21a76da DL	60	;; Do this in case we're called from Gnus, say, in a buffer
	61	;; which already contains non-ASCII characters which would
	62	;; then get doubly-decoded below.
	63	(if coding-system
	64	(mm-encode-coding-region (point-min) (point-max) coding-system))
	65	(goto-char (point-min))
e4f99da7	66	(while (and (skip-chars-forward "^=")
657b2c65 DL	67	(not (eobp)))
	68	(cond ((eq (char-after (1+ (point))) ?\n)
	69	(delete-char 2))
	70	((looking-at "=[0-9A-F][0-9A-F]")
	71	(let ((byte (string-to-int (buffer-substring (1+ (point))
	72	(+ 3 (point)))
	73	16)))
5f8dd322	74	(mm-insert-byte byte 1)
23f87bed	75	(delete-char 3)))
657b2c65	76	(t
23f87bed	77	(message "Malformed quoted-printable text")
d21a76da DL	78	(forward-char)))))
	79	(if coding-system
	80	(mm-decode-coding-region (point-min) (point-max) coding-system)))))
c113de23	81
d21a76da	82	(defun quoted-printable-decode-string (string &optional coding-system)
657b2c65	83	"Decode the quoted-printable encoded STRING and return the result.
23f87bed MB	84	If CODING-SYSTEM is non-nil, decode the region with coding-system.
	85	Use of CODING-SYSTEM is deprecated; this function should deal with
	86	raw bytes, and coding conversion should be done separately."
	87	(mm-with-unibyte-buffer
c113de23	88	(insert string)
d21a76da	89	(quoted-printable-decode-region (point-min) (point-max) coding-system)
c113de23 GM	90	(buffer-string)))
	91
	92	(defun quoted-printable-encode-region (from to &optional fold class)
657b2c65	93	"Quoted-printable encode the region between FROM and TO per RFC 2045.
c113de23	94
657b2c65	95	If FOLD, fold long lines at 76 characters (as required by the RFC).
e4f99da7 DL	96	If CLASS is non-nil, translate the characters not matched by that
	97	regexp class, which is in the form expected by `skip-chars-forward'.
	98	You should probably avoid non-ASCII characters in this arg.
c113de23	99
657b2c65	100	If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
c113de23 GM	101	encode lines starting with \"From\"."
c113de23 GM	102	(interactive "r")
5f8dd322 DL	103	(save-excursion
	104	(goto-char from)
	105	(if (fboundp 'string-to-multibyte) ; Emacs 22
	106	(if (re-search-forward (string-to-multibyte "[^\x0-\x7f\x80-\xff]")
	107	to t)
	108	;; Fixme: This is somewhat misleading.
	109	(error "Multibyte character in QP encoding region"))
	110	(if (re-search-forward (mm-string-as-multibyte "[^\0-\377]") to t)
	111	(error "Multibyte character in QP encoding region"))))
657b2c65	112	(unless class
158d6e07 SZ	113	;; Avoid using 8bit characters. = is \075.
	114	;; Equivalent to "^\000-\007\013\015-\037\200-\377="
	115	(setq class "\010-\012\014\040-\074\076-\177"))
c113de23 GM	116	(save-excursion
	117	(save-restriction
	118	(narrow-to-region from to)
e4f99da7 DL	119	;; Encode all the non-ascii and control characters.
	120	(goto-char (point-min))
	121	(while (and (skip-chars-forward class)
	122	(not (eobp)))
	123	(insert
	124	(prog1
5f8dd322 DL	125	;; To unibyte in case of Emacs 22 eight-bit.
5f8dd322 DL	126	(format "=%02X" (mm-multibyte-char-to-unibyte (char-after)))
e4f99da7 DL	127	(delete-char 1))))
	128	;; Encode white space at the end of lines.
	129	(goto-char (point-min))
	130	(while (re-search-forward "[ \t]+$" nil t)
	131	(goto-char (match-beginning 0))
	132	(while (not (eolp))
c113de23 GM	133	(insert
c113de23 GM	134	(prog1
158d6e07	135	(format "=%02X" (char-after))
b03b1ad2 DL	136	(delete-char 1)))))
	137	(let ((mm-use-ultra-safe-encoding
	138	(and (boundp 'mm-use-ultra-safe-encoding)
	139	mm-use-ultra-safe-encoding)))
	140	(when (or fold mm-use-ultra-safe-encoding)
	141	(let ((tab-width 1)) ; HTAB is one character.
	142	(goto-char (point-min))
	143	(while (not (eobp))
	144	;; In ultra-safe mode, encode "From " at the beginning
	145	;; of a line.
	146	(when mm-use-ultra-safe-encoding
	147	(if (looking-at "From ")
	148	(replace-match "From=20" nil t)
	149	(if (looking-at "-")
	150	(replace-match "=2D" nil t))))
	151	(end-of-line)
	152	;; Fold long lines.
	153	(while (> (current-column) 76) ; tab-width must be 1.
	154	(beginning-of-line)
	155	(forward-char 75) ; 75 chars plus an "="
	156	(search-backward "=" (- (point) 2) t)
	157	(insert "=\n")
	158	(end-of-line))
	159	(forward-line))))))))
c113de23 GM	160
c113de23 GM	161	(defun quoted-printable-encode-string (string)
657b2c65	162	"Encode the STRING as quoted-printable and return the result."
e4f99da7 DL	163	(let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
	164	(with-temp-buffer
	165	(insert string)
	166	(quoted-printable-encode-region (point-min) (point-max))
	167	(buffer-string))))
c113de23 GM	168
	169	(provide 'qp)
	170
ab5796a9	171	;;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba
657b2c65	172	;;; qp.el ends here