X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bfab7c6ec74dc55d640ef36f8cb1790a1420f991..22bcf2046977620a7f37bbd4dff4be4a4fffc0ed:/lisp/format.el diff --git a/lisp/format.el b/lisp/format.el index 9be8b5c112..61c68870e0 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -1,16 +1,17 @@ ;;; format.el --- read and save files in multiple formats -;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 1997, 1999, 2001-2011 +;; Free Software Foundation, Inc. ;; Author: Boris Goldowsky +;; Package: emacs ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, 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 @@ -18,9 +19,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -66,39 +65,42 @@ (put 'buffer-auto-save-file-format 'permanent-local t) (defvar format-alist - '((text/enriched "Extended MIME text/enriched format." - "Content-[Tt]ype:[ \t]*text/enriched" + ;; FIXME: maybe each item can be purecopied instead of just the strings. + `((text/enriched ,(purecopy "Extended MIME text/enriched format.") + ,(purecopy "Content-[Tt]ype:[ \t]*text/enriched") enriched-decode enriched-encode t enriched-mode) - (plain "ISO 8859-1 standard format, no text properties." + (plain ,(purecopy "ISO 8859-1 standard format, no text properties.") ;; Plain only exists so that there is an obvious neutral choice in ;; the completion list. nil nil nil nil nil) - (TeX "TeX (encoding)" + (TeX ,(purecopy "TeX (encoding)") nil iso-tex2iso iso-iso2tex t nil) - (gtex "German TeX (encoding)" + (gtex ,(purecopy "German TeX (encoding)") nil iso-gtex2iso iso-iso2gtex t nil) - (html "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)" + (html ,(purecopy "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)") nil iso-sgml2iso iso-iso2sgml t nil) - (rot13 "rot13" + (rot13 ,(purecopy "rot13") nil - "tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil) - (duden "Duden Ersatzdarstellung" + ,(purecopy "tr a-mn-z n-za-m") ,(purecopy "tr a-mn-z n-za-m") t nil) + (duden ,(purecopy "Duden Ersatzdarstellung") nil - "diac" iso-iso2duden t nil) - (de646 "German ASCII (ISO 646)" + ,(purecopy "diac") iso-iso2duden t nil) + (de646 ,(purecopy "German ASCII (ISO 646)") nil - "recode -f iso646-ge:latin1" "recode -f latin1:iso646-ge" t nil) - (denet "net German" + ,(purecopy "recode -f iso646-ge:latin1") + ,(purecopy "recode -f latin1:iso646-ge") t nil) + (denet ,(purecopy "net German") nil iso-german iso-cvt-read-only t nil) - (esnet "net Spanish" + (esnet ,(purecopy "net Spanish") nil iso-spanish iso-cvt-read-only t nil)) "List of information about understood file formats. -Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN). +Elements are of the form +\(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN PRESERVE). NAME is a symbol, which is stored in `buffer-file-format'. @@ -107,9 +109,9 @@ DOC-STR should be a single line providing more information about the the user if they ask for more information. REGEXP is a regular expression to match against the beginning of the file; - it should match only files in that format. Use nil to avoid - matching at all for formats for which it isn't appropriate to - require explicit encoding/decoding. + it should match only files in that format. REGEXP may be nil, in + which case the format will never be applied automatically to a file. + Use this for formats that you only ever want to apply manually. FROM-FN is called to decode files in that format; it takes two args, BEGIN and END, and can make any modifications it likes, returning the new @@ -137,6 +139,8 @@ MODE-FN, if specified, is called when visiting a file with that format. PRESERVE, if non-nil, means that `format-write-file' should not remove this format from `buffer-file-format'.") +;;;###autoload +(put 'format-alist 'risky-local-variable t) ;;; Basic Functions (called from Lisp) @@ -163,10 +167,10 @@ BUFFER should be the buffer that the output originally came from." (error "Format encoding failed"))) (funcall method from to buffer))) -(defun format-decode-run-method (method from to &optional buffer) +(defun format-decode-run-method (method from to &optional _buffer) "Decode using METHOD the text from FROM to TO. If METHOD is a string, it is a shell command (including options); otherwise, -it should be a Lisp function. Decoding is done for the given BUFFER." +it should be a Lisp function. BUFFER is currently ignored." (if (stringp method) (let ((error-buff (get-buffer-create "*Format Errors*")) (coding-system-for-write 'no-conversion) @@ -177,8 +181,7 @@ it should be a Lisp function. Decoding is done for the given BUFFER." ;; We should perhaps go via a temporary buffer and copy it ;; back, in case of errors. (if (and (zerop (save-window-excursion - (shell-command-on-region (point-min) (point-max) - method t t + (shell-command-on-region from to method t t error-buff))) ;; gzip gives zero exit status with bad args, for instance. (zerop (with-current-buffer error-buff @@ -226,6 +229,15 @@ For most purposes, consider using `format-encode-region' instead." (set-buffer copy-buf) (format-insert-annotations write-region-annotations-so-far from) (format-encode-run-method to-fn (point-min) (point-max) orig-buf) + (when (buffer-live-p copy-buf) + (with-current-buffer copy-buf + ;; Set write-region-post-annotation-function to + ;; delete the buffer once the write is done, but do + ;; it after running to-fn so it doesn't affect + ;; write-region calls in to-fn. + (set (make-local-variable + 'write-region-post-annotation-function) + 'kill-buffer))) nil) ;; Otherwise just call function, it will return annotations. (funcall to-fn from to orig-buf))))) @@ -344,13 +356,11 @@ one of the formats defined in `format-alist', or a list of such symbols." (if (symbolp format) (setq format (list format))) (save-excursion (goto-char end) - (let ((cur-buf (current-buffer)) - (end (point-marker))) + (let ((end (point-marker))) (while format (let* ((info (assq (car format) format-alist)) (to-fn (nth 4 info)) - (modify (nth 5 info)) - result) + (modify (nth 5 info))) (if to-fn (if modify (setq end (format-encode-run-method to-fn beg end @@ -360,13 +370,19 @@ one of the formats defined in `format-alist', or a list of such symbols." (setq format (cdr format))))))) (defun format-write-file (filename format &optional confirm) - "Write current buffer into file FILENAME using some FORMAT. -Make buffer visit that file and set the format as the default for future -saves. If the buffer is already visiting a file, you can specify a directory -name as FILENAME, to write a file of the same old name in that directory. - -If optional third arg CONFIRM is non-nil, ask for confirmation before -overwriting an existing file. Interactively, confirmation is required + "Write current buffer into FILENAME, using a format based on FORMAT. +Constructs the actual format starting from FORMAT, then appending +any elements from the value of `buffer-file-format' with a non-nil +`preserve' flag (see the documentation of `format-alist'), if they +are not already present in FORMAT. It then updates `buffer-file-format' +with this format, making it the default for future saves. + +If the buffer is already visiting a file, you can specify a +directory name as FILENAME, to write a file of the same old name +in that directory. + +If optional third arg CONFIRM is non-nil, asks for confirmation before +overwriting an existing file. Interactively, requires confirmation unless you supply a prefix argument." (interactive ;; Same interactive spec as write-file, plus format question. @@ -521,22 +537,6 @@ Compare using `equal'." (setq tail next))) (cons acopy bcopy))) -(defun format-common-tail (a b) - "Given two lists that have a common tail, return it. -Compare with `equal', and return the part of A that is equal to the -equivalent part of B. If even the last items of the two are not equal, -return nil." - (let ((la (length a)) - (lb (length b))) - ;; Make sure they are the same length - (if (> la lb) - (setq a (nthcdr (- la lb) a)) - (setq b (nthcdr (- lb la) b)))) - (while (not (equal a b)) - (setq a (cdr a) - b (cdr b))) - a) - (defun format-proper-list-p (list) "Return t if LIST is a proper list. A proper list is a list ending with a nil cdr, not with an atom " @@ -623,7 +623,7 @@ to write these unknown annotations back into the file." (save-restriction (narrow-to-region (point-min) to) (goto-char from) - (let (next open-ans todo loc unknown-ans) + (let (next open-ans todo unknown-ans) (while (setq next (funcall next-fn)) (let* ((loc (nth 0 next)) (end (nth 1 next)) @@ -914,12 +914,11 @@ The same TRANSLATIONS structure can be used in reverse for reading files." all-ans)) (setq neg-ans (cdr neg-ans))) ;; Now deal with positive (opening) annotations - (let ((p pos-ans)) - (while pos-ans - (push (car pos-ans) open-ans) - (push (cons loc (funcall format-fn (car pos-ans) t)) - all-ans) - (setq pos-ans (cdr pos-ans)))))) + (while pos-ans + (push (car pos-ans) open-ans) + (push (cons loc (funcall format-fn (car pos-ans) t)) + all-ans) + (setq pos-ans (cdr pos-ans))))) ;; Close any annotations still open (while open-ans @@ -998,8 +997,7 @@ They can be whatever the FORMAT-FN in `format-annotate-region' can handle. If that is `enriched-make-annotation', they can be either strings, or lists of the form (PARAMETER VALUE)." - (let ((prop-alist (cdr (assoc prop translations))) - default) + (let ((prop-alist (cdr (assoc prop translations)))) (if (not prop-alist) nil ;; If either old or new is a list, have to treat both that way. @@ -1010,7 +1008,6 @@ either strings, or lists of the form (PARAMETER VALUE)." (format-annotate-atomic-property-change prop-alist old new) (let* ((old (if (listp old) old (list old))) (new (if (listp new) new (list new))) - (tail (format-common-tail old new)) close open) (while old (setq close @@ -1069,5 +1066,4 @@ OLD and NEW are the values." (provide 'format) -;; arch-tag: c387e9c7-a93d-47bf-89bc-8ca67e96755a ;;; format.el ends here