Mercurial > hg > xemacs-beta

comparison lisp/mel/mel-q.el @ 177:6075d714658b r20-3b15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b15
author cvs
date Mon, 13 Aug 2007 09:51:16 +0200
parents 15872534500d
children
comparison
equal deleted inserted replaced
176:6866abce6aaf 177:6075d714658b
2 2
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
4 4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Created: 1995/6/25 6 ;; Created: 1995/6/25
7 ;; Version: $Id: mel-q.el,v 1.4 1997/07/07 00:52:59 steve Exp $ 7 ;; Version: $Id: mel-q.el,v 1.5 1997/07/26 22:09:47 steve Exp $
8 ;; Keywords: MIME, Quoted-Printable, Q-encoding 8 ;; Keywords: MIME, Quoted-Printable, Q-encoding
9 9
10 ;; This file is part of MEL (MIME Encoding Library). 10 ;; This file is part of MEL (MIME Encoding Library).
11 11
12 ;; This program is free software; you can redistribute it and/or 12 ;; This program is free software; you can redistribute it and/or
27 ;;; Code: 27 ;;; Code:
28 28
29 (require 'emu) 29 (require 'emu)
30 30
31 31
32 ;;; @ constants 32 ;;; @ Quoted-Printable encoder
33 ;;; 33 ;;;
34 34
35 (defconst quoted-printable-hex-chars "0123456789ABCDEF") 35 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
36 (defconst quoted-printable-octet-regexp 36
37 (concat "=[" quoted-printable-hex-chars 37 (defsubst quoted-printable-quote-char (character)
38 "][" quoted-printable-hex-chars "]")) 38 (concat
39 39 "="
40 40 (char-to-string (aref quoted-printable-hex-chars (ash character -4)))
41 ;;; @ variables 41 (char-to-string (aref quoted-printable-hex-chars (logand character 15)))
42 ;;; 42 ))
43
44 (defun quoted-printable-internal-encode-region (start end)
45 (save-excursion
46 (save-restriction
47 (narrow-to-region start end)
48 (goto-char start)
49 (let ((col 0)
50 enable-multibyte-characters)
51 (while (< (point)(point-max))
52 (cond ((>= col 75)
53 (insert "=\n")
54 (setq col 0)
55 )
56 ((looking-at "^From ")
57 (replace-match "=46rom ")
58 (backward-char 1)
59 (setq col (+ col 6))
60 )
61 ((looking-at "[ \t]\n")
62 (forward-char 1)
63 (insert "=\n")
64 (forward-char 1)
65 (setq col 0)
66 )
67 (t
68 (let ((chr (char-after (point))))
69 (cond ((= chr ?\n)
70 (forward-char 1)
71 (setq col 0)
72 )
73 ((or (= chr ?\t)
74 (and (<= 32 chr)(/= chr ?=)(< chr 127))
75 )
76 (forward-char 1)
77 (setq col (1+ col))
78 )
79 ((>= col 73)
80 (insert "=\n")
81 (setq col 0)
82 )
83 (t
84 (delete-char 1)
85 (insert (quoted-printable-quote-char chr))
86 (setq col (+ col 3))
87 ))
88 )))
89 )))))
43 90
44 (defvar quoted-printable-external-encoder '("mmencode" "-q") 91 (defvar quoted-printable-external-encoder '("mmencode" "-q")
45 "*list of quoted-printable encoder program name and its arguments.") 92 "*list of quoted-printable encoder program name and its arguments.")
46 93
47 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u") 94 (defun quoted-printable-external-encode-region (start end)
48 "*list of quoted-printable decoder program name and its arguments.") 95 (save-excursion
49 96 (save-restriction
50 (defvar quoted-printable-internal-encoding-limit 10000 97 (narrow-to-region start end)
98 (as-binary-process
99 (apply (function call-process-region)
100 start end (car quoted-printable-external-encoder)
101 t t nil (cdr quoted-printable-external-encoder))
102 )
103 ;; for OS/2
104 ;; regularize line break code
105 (goto-char (point-min))
106 (while (re-search-forward "\r$" nil t)
107 (replace-match "")
108 )
109 )))
110
111 (defvar quoted-printable-internal-encoding-limit
112 (if (and (featurep 'xemacs)(featurep 'mule))
113 0
114 (require 'file-detect)
115 (if (exec-installed-p "mmencode")
116 1000
117 (message "Don't found external encoder for Quoted-Printable!")
118 nil))
51 "*limit size to use internal quoted-printable encoder. 119 "*limit size to use internal quoted-printable encoder.
52 If size of input to encode is larger than this limit, 120 If size of input to encode is larger than this limit,
53 external encoder is called.") 121 external encoder is called.")
54 122
55 (defvar quoted-printable-internal-decoding-limit nil 123 (defun quoted-printable-encode-region (start end)
56 "*limit size to use internal quoted-printable decoder. 124 "Encode current region by quoted-printable.
57 If size of input to decode is larger than this limit, 125 START and END are buffer positions.
58 external decoder is called.") 126 This function calls internal quoted-printable encoder if size of
59 127 region is smaller than `quoted-printable-internal-encoding-limit',
60 128 otherwise it calls external quoted-printable encoder specified by
61 ;;; @ Quoted-Printable (Q-encode) encoder/decoder 129 `quoted-printable-external-encoder'. In this case, you must install
62 ;;; 130 the program (maybe mmencode included in metamail or XEmacs package)."
63 131 (interactive "r")
64 (defun byte-to-hex-string (num) 132 (if (and quoted-printable-internal-encoding-limit
65 (concat (char-to-string (elt quoted-printable-hex-chars (ash num -4))) 133 (> (- end start) quoted-printable-internal-encoding-limit))
66 (char-to-string (elt quoted-printable-hex-chars (logand num 15))) 134 (quoted-printable-external-encode-region start end)
67 )) 135 (quoted-printable-internal-encode-region start end)
68 136 ))
69 (defun quoted-printable-quote-char (chr)
70 (concat "="
71 (char-to-string (elt quoted-printable-hex-chars (ash chr -4)))
72 (char-to-string (elt quoted-printable-hex-chars (logand chr 15)))
73 ))
74
75
76 ;;; @@ Quoted-Printable encoder/decoder for string
77 ;;;
78 137
79 (defun quoted-printable-encode-string (string) 138 (defun quoted-printable-encode-string (string)
80 "Encode STRING to quoted-printable, and return the result." 139 "Encode STRING to quoted-printable, and return the result."
81 (let ((i 0)) 140 (with-temp-buffer
82 (mapconcat (function 141 (insert string)
83 (lambda (chr) 142 (quoted-printable-encode-region (point-min)(point-max))
84 (cond ((eq chr ?\n) 143 (buffer-string)
85 (setq i 0) 144 ))
86 "\n") 145
87 ((or (< chr 32) (< 126 chr) (eq chr ?=)) 146 (defun quoted-printable-insert-encoded-file (filename)
88 (if (>= i 73) 147 "Encode contents of file FILENAME to quoted-printable, and insert the result.
89 (progn 148 It calls external quoted-printable encoder specified by
90 (setq i 3) 149 `quoted-printable-external-encoder'. So you must install the program
91 (concat "=\n" (quoted-printable-quote-char chr)) 150 \(maybe mmencode included in metamail or XEmacs package)."
92 ) 151 (interactive (list (read-file-name "Insert encoded file: ")))
93 (progn 152 (apply (function call-process) (car quoted-printable-external-encoder)
94 (setq i (+ i 3)) 153 filename t nil (cdr quoted-printable-external-encoder))
95 (quoted-printable-quote-char chr) 154 )
96 ))) 155
97 (t (if (>= i 75) 156
98 (progn 157 ;;; @ Quoted-Printable decoder
99 (setq i 1) 158 ;;;
100 (concat "=\n" (char-to-string chr))
101 )
102 (progn
103 (setq i (1+ i))
104 (char-to-string chr)
105 )))
106 )))
107 string "")))
108 159
109 (defun quoted-printable-decode-string (string) 160 (defun quoted-printable-decode-string (string)
110 "Decode STRING which is encoded in quoted-printable, and return the result." 161 "Decode STRING which is encoded in quoted-printable, and return the result."
111 (let (q h l) 162 (let (q h l)
112 (mapconcat (function 163 (mapconcat (function
132 ) 183 )
133 (t (char-to-string chr)) 184 (t (char-to-string chr))
134 ))) 185 )))
135 string ""))) 186 string "")))
136 187
137 188 (defconst quoted-printable-octet-regexp
138 ;;; @@ Quoted-Printable encoder/decoder for region 189 (concat "=[" quoted-printable-hex-chars
139 ;;; 190 "][" quoted-printable-hex-chars "]"))
140 191
141 (defun quoted-printable-internal-encode-region (beg end) 192 (defun quoted-printable-internal-decode-region (start end)
142 (save-excursion 193 (save-excursion
143 (save-restriction 194 (save-restriction
144 (narrow-to-region beg end) 195 (narrow-to-region start end)
145 (let ((str (buffer-substring beg end)))
146 (delete-region beg end)
147 (insert (quoted-printable-encode-string str))
148 )
149 (or (bolp)
150 (insert "=\n")
151 )
152 )))
153
154 (defun quoted-printable-internal-decode-region (beg end)
155 (save-excursion
156 (save-restriction
157 (narrow-to-region beg end)
158 (goto-char (point-min)) 196 (goto-char (point-min))
159 (while (re-search-forward "=\n" nil t) 197 (while (re-search-forward "=\n" nil t)
160 (replace-match "") 198 (replace-match "")
161 ) 199 )
162 (goto-char (point-min)) 200 (goto-char (point-min))
168 (delete-region b e) 206 (delete-region b e)
169 (insert (quoted-printable-decode-string str)) 207 (insert (quoted-printable-decode-string str))
170 )) 208 ))
171 ))) 209 )))
172 210
173 (defun quoted-printable-external-encode-region (beg end) 211 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
174 (save-excursion 212 "*list of quoted-printable decoder program name and its arguments.")
175 (save-restriction 213
176 (narrow-to-region beg end) 214 (defun quoted-printable-external-decode-region (start end)
177 (as-binary-process
178 (apply (function call-process-region)
179 beg end (car quoted-printable-external-encoder)
180 t t nil (cdr quoted-printable-external-encoder))
181 )
182 ;; for OS/2
183 ;; regularize line break code
184 (goto-char (point-min))
185 (while (re-search-forward "\r$" nil t)
186 (replace-match "")
187 )
188 )))
189
190 (defun quoted-printable-external-decode-region (beg end)
191 (save-excursion 215 (save-excursion
192 (as-binary-process 216 (as-binary-process
193 (apply (function call-process-region) 217 (apply (function call-process-region)
194 beg end (car quoted-printable-external-decoder) 218 start end (car quoted-printable-external-decoder)
195 t t nil (cdr quoted-printable-external-decoder)) 219 t t nil (cdr quoted-printable-external-decoder))
196 ))) 220 )))
197 221
198 (defun quoted-printable-encode-region (beg end) 222 (defvar quoted-printable-internal-decoding-limit nil
199 "Encode current region by quoted-printable. 223 "*limit size to use internal quoted-printable decoder.
200 START and END are buffer positions. 224 If size of input to decode is larger than this limit,
201 This function calls internal quoted-printable encoder if size of 225 external decoder is called.")
202 region is smaller than `quoted-printable-internal-encoding-limit', 226
203 otherwise it calls external quoted-printable encoder specified by 227 (defun quoted-printable-decode-region (start end)
204 `quoted-printable-external-encoder'. In this case, you must install
205 the program (maybe mmencode included in metamail or XEmacs package)."
206 (interactive "r")
207 (if (and quoted-printable-internal-encoding-limit
208 (> (- end beg) quoted-printable-internal-encoding-limit))
209 (quoted-printable-external-encode-region beg end)
210 (quoted-printable-internal-encode-region beg end)
211 ))
212
213 (defun quoted-printable-decode-region (beg end)
214 "Decode current region by quoted-printable. 228 "Decode current region by quoted-printable.
215 START and END are buffer positions. 229 START and END are buffer positions.
216 This function calls internal quoted-printable decoder if size of 230 This function calls internal quoted-printable decoder if size of
217 region is smaller than `quoted-printable-internal-decoding-limit', 231 region is smaller than `quoted-printable-internal-decoding-limit',
218 otherwise it calls external quoted-printable decoder specified by 232 otherwise it calls external quoted-printable decoder specified by
219 `quoted-printable-external-decoder'. In this case, you must install 233 `quoted-printable-external-decoder'. In this case, you must install
220 the program (maybe mmencode included in metamail or XEmacs package)." 234 the program (maybe mmencode included in metamail or XEmacs package)."
221 (interactive "r") 235 (interactive "r")
222 (if (and quoted-printable-internal-decoding-limit 236 (if (and quoted-printable-internal-decoding-limit
223 (> (- end beg) quoted-printable-internal-decoding-limit)) 237 (> (- end start) quoted-printable-internal-decoding-limit))
224 (quoted-printable-external-decode-region beg end) 238 (quoted-printable-external-decode-region start end)
225 (quoted-printable-internal-decode-region beg end) 239 (quoted-printable-internal-decode-region start end)
226 )) 240 ))
227
228
229 ;;; @@ Quoted-Printable encoder/decoder for file
230 ;;;
231
232 (defun quoted-printable-insert-encoded-file (filename)
233 "Encode contents of file FILENAME to quoted-printable, and insert the result.
234 It calls external quoted-printable encoder specified by
235 `quoted-printable-external-encoder'. So you must install the program
236 (maybe mmencode included in metamail or XEmacs package)."
237 (interactive (list (read-file-name "Insert encoded file: ")))
238 (apply (function call-process) (car quoted-printable-external-encoder)
239 filename t nil (cdr quoted-printable-external-encoder))
240 )
241 241
242 242
243 ;;; @ Q-encoding encode/decode string 243 ;;; @ Q-encoding encode/decode string
244 ;;; 244 ;;;
245 245