Mercurial > emacs

comparison lisp/gnus/qp.el @ 35619:a670d2680870

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Remove un-logged bogus changes from 2000-12-20. (quoted-printable-encode-region): Doc fix. Don't call string-as-multibyte on class. Clarify line-folding. (quoted-printable-encode-string): Make temp buffer inherit string's multibyteness.
author Dave Love <fx@gnu.org>
date Fri, 26 Jan 2001 19:08:15 +0000
parents f04f551e94ce
children ccc41398da84
comparison
equal deleted inserted replaced
35618:04f8ee49a6db 35619:a670d2680870
1 ;;; qp.el --- Quoted-Printable functions 1 ;;; qp.el --- Quoted-Printable functions
2 2
3 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. 3 ;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
4 4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: mail, extensions 6 ;; Keywords: mail, extensions
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
51 ;; which already contains non-ASCII characters which would 51 ;; which already contains non-ASCII characters which would
52 ;; then get doubly-decoded below. 52 ;; then get doubly-decoded below.
53 (if coding-system 53 (if coding-system
54 (mm-encode-coding-region (point-min) (point-max) coding-system)) 54 (mm-encode-coding-region (point-min) (point-max) coding-system))
55 (goto-char (point-min)) 55 (goto-char (point-min))
56 (while (and (skip-chars-forward "^=" to) 56 (while (and (skip-chars-forward "^=")
57 (not (eobp))) 57 (not (eobp)))
58 (cond ((eq (char-after (1+ (point))) ?\n) 58 (cond ((eq (char-after (1+ (point))) ?\n)
59 (delete-char 2)) 59 (delete-char 2))
60 ((looking-at "=[0-9A-F][0-9A-F]") 60 ((looking-at "=[0-9A-F][0-9A-F]")
61 (let ((byte (string-to-int (buffer-substring (1+ (point)) 61 (let ((byte (string-to-int (buffer-substring (1+ (point))
81 81
82 (defun quoted-printable-encode-region (from to &optional fold class) 82 (defun quoted-printable-encode-region (from to &optional fold class)
83 "Quoted-printable encode the region between FROM and TO per RFC 2045. 83 "Quoted-printable encode the region between FROM and TO per RFC 2045.
84 84
85 If FOLD, fold long lines at 76 characters (as required by the RFC). 85 If FOLD, fold long lines at 76 characters (as required by the RFC).
86 If CLASS is non-nil, translate the characters matched by that class in 86 If CLASS is non-nil, translate the characters not matched by that
87 the form expected by `skip-chars-forward'. 87 regexp class, which is in the form expected by `skip-chars-forward'.
88 You should probably avoid non-ASCII characters in this arg.
88 89
89 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and 90 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
90 encode lines starting with \"From\"." 91 encode lines starting with \"From\"."
91 (interactive "r") 92 (interactive "r")
93 ;; Fixme: what should this do in XEmacs/Mule?
94 (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule
95 (if (delq 'unknown ; Emacs 20 unibyte
96 (delq 'eight-bit-graphic ; Emacs 21
97 (delq 'eight-bit-control
98 (delq 'ascii (find-charset-region from to)))))
99 (error "Multibyte character in QP encoding region")))
92 (unless class 100 (unless class
93 ;; Avoid using 8bit characters. = is \075. 101 ;; Avoid using 8bit characters. = is \075.
94 ;; Equivalent to "^\000-\007\013\015-\037\200-\377=" 102 ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
95 (setq class "\010-\012\014\040-\074\076-\177")) 103 (setq class "\010-\012\014\040-\074\076-\177"))
96 (if (fboundp 'string-as-multibyte)
97 (setq class (string-as-multibyte class)))
98 (save-excursion 104 (save-excursion
99 (save-restriction 105 (save-restriction
100 (narrow-to-region from to) 106 (narrow-to-region from to)
101 (mm-with-unibyte-current-buffer-mule4 107 ;; Encode all the non-ascii and control characters.
102 ;; Fixme: what should this do in XEmacs/Mule? 108 (goto-char (point-min))
103 (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule 109 (while (and (skip-chars-forward class)
104 (if (delq 'unknown ; Emacs 20 unibyte 110 (not (eobp)))
105 (delq 'eight-bit-graphic ; Emacs 21 111 (insert
106 (delq 'eight-bit-control 112 (prog1
107 (delq 'ascii 113 (format "=%02X" (char-after))
108 (find-charset-region from to))))) 114 (delete-char 1))))
109 (error "Multibyte character in QP encoding region"))) 115 ;; Encode white space at the end of lines.
110 ;; Encode all the non-ascii and control characters. 116 (goto-char (point-min))
111 (goto-char (point-min)) 117 (while (re-search-forward "[ \t]+$" nil t)
112 (while (and (skip-chars-forward class) 118 (goto-char (match-beginning 0))
113 (not (eobp))) 119 (while (not (eolp))
114 (insert 120 (insert
115 (prog1 121 (prog1
116 (format "=%02X" (char-after)) 122 (format "=%02X" (char-after))
117 (delete-char 1)))) 123 (delete-char 1))))
118 ;; Encode white space at the end of lines. 124 ;; Encode white space at the end of lines.
126 (delete-char 1))))) 132 (delete-char 1)))))
127 (let ((mm-use-ultra-safe-encoding 133 (let ((mm-use-ultra-safe-encoding
128 (and (boundp 'mm-use-ultra-safe-encoding) 134 (and (boundp 'mm-use-ultra-safe-encoding)
129 mm-use-ultra-safe-encoding))) 135 mm-use-ultra-safe-encoding)))
130 (when (or fold mm-use-ultra-safe-encoding) 136 (when (or fold mm-use-ultra-safe-encoding)
131 ;; Fold long lines. 137 (let ((tab-width 1)) ; HTAB is one character.
132 (let ((tab-width 1)) ; HTAB is one character.
133 (goto-char (point-min)) 138 (goto-char (point-min))
134 (while (not (eobp)) 139 (while (not (eobp))
135 ;; In ultra-safe mode, encode "From " at the beginning 140 ;; In ultra-safe mode, encode "From " at the beginning
136 ;; of a line. 141 ;; of a line.
137 (when mm-use-ultra-safe-encoding 142 (when mm-use-ultra-safe-encoding
138 (beginning-of-line)
139 (if (looking-at "From ") 143 (if (looking-at "From ")
140 (replace-match "From=20" nil t) 144 (replace-match "From=20" nil t)
141 (if (looking-at "-") 145 (if (looking-at "-")
142 (replace-match "=2D" nil t)))) 146 (replace-match "=2D" nil t))))
143 (end-of-line) 147 (end-of-line)
144 (while (> (current-column) 76) ; tab-width must be 1. 148 ;; Fold long lines.
145 (beginning-of-line) 149 (while (> (current-column) 76) ; tab-width must be 1.
146 (forward-char 75) ; 75 chars plus an "=" 150 (beginning-of-line)
147 (search-backward "=" (- (point) 2) t) 151 (forward-char 75) ; 75 chars plus an "="
148 (insert "=\n") 152 (search-backward "=" (- (point) 2) t)
149 (end-of-line)) 153 (insert "=\n")
150 (unless (eobp) 154 (end-of-line))
151 (forward-line)))))))))) 155 (forward-line)))))))))
152 156
153 (defun quoted-printable-encode-string (string) 157 (defun quoted-printable-encode-string (string)
154 "Encode the STRING as quoted-printable and return the result." 158 "Encode the STRING as quoted-printable and return the result."
155 (with-temp-buffer 159 (let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
156 (insert string) 160 (with-temp-buffer
157 (quoted-printable-encode-region (point-min) (point-max)) 161 (insert string)
158 (buffer-string))) 162 (quoted-printable-encode-region (point-min) (point-max))
163 (buffer-string))))
159 164
160 (provide 'qp) 165 (provide 'qp)
161 166
162 ;;; qp.el ends here 167 ;;; qp.el ends here