comparison lisp/format.el @ 18140:f16cf00a2f42

(format-insert-file): Fix arg order to format-decode.
author Richard M. Stallman <rms@gnu.org>
date Wed, 04 Jun 1997 19:06:35 +0000
parents 380e33f3a5c6
children df8ab82c73f3
comparison
equal deleted inserted replaced
18139:ee3c0d09dcd3 18140:f16cf00a2f42
1 ;;; format.el --- read and save files in multiple formats 1 ;;; format.el --- read and save files in multiple formats
2 2
3 ;; Copyright (c) 1994, 1995 Free Software Foundation 3 ;; Copyright (c) 1994, 1995, 1997 Free Software Foundation
4 4
5 ;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu> 5 ;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
8 8
62 ;;; Code: 62 ;;; Code:
63 63
64 (put 'buffer-file-format 'permanent-local t) 64 (put 'buffer-file-format 'permanent-local t)
65 65
66 (defvar format-alist 66 (defvar format-alist
67 '((text/enriched "Extended MIME text/enriched format." 67 '((compressed "compressed"
68 "^\037\213" ; magic number for gzip
69 "gunzip -f" "gzip -f" t nil)
70 (text/enriched "Extended MIME text/enriched format."
68 "Content-[Tt]ype:[ \t]*text/enriched" 71 "Content-[Tt]ype:[ \t]*text/enriched"
69 enriched-decode enriched-encode t enriched-mode) 72 enriched-decode enriched-encode t enriched-mode)
70 (plain "Standard ASCII format, no text properties." 73 (plain "ISO 8859-1 standard format, no text properties."
71 ;; Plain only exists so that there is an obvious neutral choice in 74 ;; Plain only exists so that there is an obvious neutral choice in
72 ;; the completion list. 75 ;; the completion list.
73 nil nil nil nil nil)) 76 nil nil nil nil nil)
77 (ibm "IBM Code Page 850 (DOS)"
78 "1\\(^\\)"
79 "recode ibm-ps:latin1" "recode latin1:ibm-pc" t nil)
80 (mac "Apple Macintosh"
81 "1\\(^\\)"
82 "recode mac:latin1" "recode latin1:mac" t nil)
83 (hp "HP Roman8"
84 "1\\(^\\)"
85 "recode roman8:latin1" "recode latin1:roman8" t nil)
86 (TeX "TeX (encoding)"
87 "1\\(^\\)"
88 iso-tex2iso iso-iso2tex t nil)
89 (gtex "German TeX (encoding)"
90 "1\\(^\\)"
91 iso-gtex2iso iso-iso2gtex t nil)
92 (html "HTML (encoding)"
93 "1\\(^\\)"
94 "recode html:latin1" "recode latin1:html" t nil)
95 (rot13 "rot13"
96 "1\\(^\\)"
97 "tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil)
98 (duden "Duden Ersatzdarstellung"
99 "1\\(^\\)"
100 "diac" iso-iso2duden t nil)
101 (de646 "German ASCII (ISO 646)"
102 "1\\(^\\)"
103 "recode iso646-ge:latin1" "recode latin1:iso646-ge" t nil)
104 (denet "net German"
105 "1\\(^\\)"
106 iso-german iso-cvt-read-only t nil)
107 (esnet "net Spanish"
108 "1\\(^\\)"
109 iso-spanish iso-cvt-read-onlyt nil))
74 "List of information about understood file formats. 110 "List of information about understood file formats.
75 Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN). 111 Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN).
76 NAME is a symbol, which is stored in `buffer-file-format'. 112 NAME is a symbol, which is stored in `buffer-file-format'.
77 DOC-STR should be a single line providing more information about the 113 DOC-STR should be a single line providing more information about the
78 format. It is currently unused, but in the future will be shown to 114 format. It is currently unused, but in the future will be shown to
94 annotations. 130 annotations.
95 MODE-FN, if specified, is called when visiting a file with that format.") 131 MODE-FN, if specified, is called when visiting a file with that format.")
96 132
97 ;;; Basic Functions (called from Lisp) 133 ;;; Basic Functions (called from Lisp)
98 134
135 (defun format-encode-run-method (method from to &optional buffer)
136 "Translate using function or shell script METHOD the text from FROM to TO.
137 If METHOD is a string, it is a shell command;
138 otherwise, it should be a Lisp function.
139 BUFFER should be the buffer that the output originally came from."
140 (if (stringp method)
141 (save-current-buffer
142 (set-buffer buffer)
143 (shell-command-on-region from to method t)
144 (point))
145 (funcall method from to buffer)))
146
147 (defun format-decode-run-method (method from to &optional buffer)
148 "Decode using function or shell script METHOD the text from FROM to TO.
149 If METHOD is a string, it is a shell command;
150 otherwise, it should be a Lisp function."
151 (if (stringp method)
152 (progn
153 (shell-command-on-region from to method t)
154 (point))
155 (funcall method from to)))
156
99 (defun format-annotate-function (format from to orig-buf) 157 (defun format-annotate-function (format from to orig-buf)
100 "Returns annotations for writing region as FORMAT. 158 "Returns annotations for writing region as FORMAT.
101 FORMAT is a symbol naming one of the formats defined in `format-alist', 159 FORMAT is a symbol naming one of the formats defined in `format-alist',
102 it must be a single symbol, not a list like `buffer-file-format'. 160 it must be a single symbol, not a list like `buffer-file-format'.
103 FROM and TO delimit the region to be operated on in the current buffer. 161 FROM and TO delimit the region to be operated on in the current buffer.
117 ;; To-function wants to modify region. Copy to safe place. 175 ;; To-function wants to modify region. Copy to safe place.
118 (let ((copy-buf (get-buffer-create " *Format Temp*"))) 176 (let ((copy-buf (get-buffer-create " *Format Temp*")))
119 (copy-to-buffer copy-buf from to) 177 (copy-to-buffer copy-buf from to)
120 (set-buffer copy-buf) 178 (set-buffer copy-buf)
121 (format-insert-annotations write-region-annotations-so-far from) 179 (format-insert-annotations write-region-annotations-so-far from)
122 (funcall to-fn (point-min) (point-max) orig-buf) 180 (format-encode-run-method to-fn (point-min) (point-max) orig-buf)
123 nil) 181 nil)
124 ;; Otherwise just call function, it will return annotations. 182 ;; Otherwise just call function, it will return annotations.
125 (funcall to-fn from to orig-buf))))) 183 (funcall to-fn from to orig-buf)))))
126 184
127 (defun format-decode (format length &optional visit-flag) 185 (defun format-decode (format length &optional visit-flag)
154 (if (and regexp (looking-at regexp) 212 (if (and regexp (looking-at regexp)
155 (< (match-end 0) (+ begin length))) 213 (< (match-end 0) (+ begin length)))
156 (progn 214 (progn
157 (setq format (cons (car f) format)) 215 (setq format (cons (car f) format))
158 ;; Decode it 216 ;; Decode it
159 (if (nth 3 f) (setq end (funcall (nth 3 f) begin end))) 217 (if (nth 3 f)
218 (setq end (format-decode-run-method (nth 3 f) begin end)))
160 ;; Call visit function if required 219 ;; Call visit function if required
161 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) 220 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
162 ;; Safeguard against either of the functions changing pt. 221 ;; Safeguard against either of the functions changing pt.
163 (goto-char p) 222 (goto-char p)
164 ;; Rewind list to look for another format 223 ;; Rewind list to look for another format
169 (let ((do format) f) 228 (let ((do format) f)
170 (while do 229 (while do
171 (or (setq f (assq (car do) format-alist)) 230 (or (setq f (assq (car do) format-alist))
172 (error "Unknown format" (car do))) 231 (error "Unknown format" (car do)))
173 ;; Decode: 232 ;; Decode:
174 (if (nth 3 f) (setq end (funcall (nth 3 f) begin end))) 233 (if (nth 3 f)
234 (setq end (format-decode-run-method (nth 3 f) begin end)))
175 ;; Call visit function if required 235 ;; Call visit function if required
176 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) 236 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
177 (setq do (cdr do))))) 237 (setq do (cdr do)))))
178 (if visit-flag 238 (if visit-flag
179 (setq buffer-file-format format)) 239 (setq buffer-file-format format))
235 (to-fn (nth 4 info)) 295 (to-fn (nth 4 info))
236 (modify (nth 5 info)) 296 (modify (nth 5 info))
237 result) 297 result)
238 (if to-fn 298 (if to-fn
239 (if modify 299 (if modify
240 (setq end (funcall to-fn beg end (current-buffer))) 300 (setq end (format-encode-run-method to-fn beg end
301 (current-buffer)))
241 (format-insert-annotations 302 (format-insert-annotations
242 (funcall to-fn beg end (current-buffer))))) 303 (funcall to-fn beg end (current-buffer)))))
243 (setq format (cdr format))))))) 304 (setq format (cdr format)))))))
244 305
245 (defun format-write-file (filename format) 306 (defun format-write-file (filename format)
293 (let (value size) 354 (let (value size)
294 (let ((format-alist nil)) 355 (let ((format-alist nil))
295 (setq value (insert-file-contents filename nil beg end)) 356 (setq value (insert-file-contents filename nil beg end))
296 (setq size (nth 1 value))) 357 (setq size (nth 1 value)))
297 (if format 358 (if format
298 (setq size (format-decode size format) 359 (setq size (format-decode format size)
299 value (cons (car value) size))) 360 value (cons (car value) size)))
300 value)) 361 value))
301 362
302 (defun format-read (&optional prompt) 363 (defun format-read (&optional prompt)
303 "Read and return the name of a format. 364 "Read and return the name of a format.
808 ;; Call "Default" function, if any 869 ;; Call "Default" function, if any
809 (let ((default (assq nil prop-alist))) 870 (let ((default (assq nil prop-alist)))
810 (if default 871 (if default
811 (funcall (car (cdr default)) old new)))))))) 872 (funcall (car (cdr default)) old new))))))))
812 873
874 (provide 'format)
813 ;; format.el ends here 875 ;; format.el ends here