Mercurial > emacs
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 |