;;; format.el --- read and save files in multiple formats
-;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997, 1999, 2001-2014 Free Software
+;; Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
+;; 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 2, 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
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
(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)
- (ibm "IBM Code Page 850 (DOS)"
- nil ; The original "1\\(^\\)" is obscure.
- "recode -f ibm-pc:latin1" "recode -f latin1:ibm-pc" t nil)
- (mac "Apple Macintosh"
- nil
- "recode -f mac:latin1" "recode -f latin1:mac" t nil)
- (hp "HP Roman8"
- nil
- "recode -f roman8:latin1" "recode -f latin1:roman8" t 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'.
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
that this would turn on some minor mode.
PRESERVE, if non-nil, means that `format-write-file' should not remove
- this format from `buffer-file-formats'.")
+ this format from `buffer-file-format'.")
+;;;###autoload
+(put 'format-alist 'risky-local-variable t)
;;; Basic Functions (called from Lisp)
(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)
;; 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
(setq selective-display sel-disp)
(set-buffer-multibyte multibyte)
(setq buffer-file-coding-system coding-system))
- (copy-to-buffer copy-buf from to)
- (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)
+ (let ((inhibit-read-only t)) ; bug#14887
+ (copy-to-buffer copy-buf from to)
+ (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)))))
(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
(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.
(fmt (format-read (format "Read file `%s' in format: "
(file-name-nondirectory file)))))
(list file fmt)))
- (let (value size)
- (let ((format-alist nil))
- (setq value (insert-file-contents filename nil beg end))
- (setq size (nth 1 value)))
- (if format
- (setq size (format-decode format size)
- value (list (car value) size)))
+ (let (value size old-undo)
+ ;; Record only one undo entry for the insertion. Inhibit point-motion and
+ ;; modification hooks as with `insert-file-contents'.
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t))
+ ;; Don't bind `buffer-undo-list' to t here to assert that
+ ;; `insert-file-contents' may record whether the buffer was unmodified
+ ;; before.
+ (let ((format-alist nil))
+ (setq value (insert-file-contents filename nil beg end))
+ (setq size (nth 1 value)))
+ (when (consp buffer-undo-list)
+ (let ((head (car buffer-undo-list)))
+ (when (and (consp head)
+ (equal (car head) (point))
+ (equal (cdr head) (+ (point) size)))
+ ;; Remove first entry from `buffer-undo-list', we shall insert
+ ;; another one below.
+ (setq old-undo (cdr buffer-undo-list)))))
+ (when format
+ (let ((buffer-undo-list t))
+ (setq size (format-decode format size)
+ value (list (car value) size)))
+ (unless (eq buffer-undo-list t)
+ (setq buffer-undo-list
+ (cons (cons (point) (+ (point) size)) old-undo)))))
+ (unless inhibit-modification-hooks
+ (run-hook-with-args 'after-change-functions (point) (+ (point) size) 0))
value))
(defun format-read (&optional prompt)
(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 "
(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))
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
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.
(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
(provide 'format)
-;;; arch-tag: c387e9c7-a93d-47bf-89bc-8ca67e96755a
;;; format.el ends here
HCoop / bpt / emacs.git / blobdiff