;;; format.el --- read and save files in multiple formats
-;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997, 1999, 2001-2016 Free Software
+;; Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Package: emacs
,(purecopy "diac") iso-iso2duden t nil)
(de646 ,(purecopy "German ASCII (ISO 646)")
nil
- ,(purecopy "recode -f iso646-ge:latin1")
+ ,(purecopy "recode -f iso646-ge:latin1")
,(purecopy "recode -f latin1:iso646-ge") t nil)
(denet ,(purecopy "net German")
nil
(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
(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
(cdr (assq 'default-directory
(buffer-local-variables)))
nil nil (buffer-name))))
- (fmt (format-read (format "Write file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Write file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt (not current-prefix-arg))))
(let ((old-formats buffer-file-format)
preserve-formats)
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
- (fmt (format-read (format "Read file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
(find-file filename))
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
- (fmt (format-read (format "Read file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt)))
(let (value size old-undo)
;; Record only one undo entry for the insertion. Inhibit point-motion and
(defun format-delq-cons (cons list)
"Remove the given CONS from LIST by side effect and return the new LIST.
Since CONS could be the first element of LIST, write
-`\(setq foo \(format-delq-cons element foo))' to be sure of changing
+\(setq foo \(format-delq-cons element foo)) to be sure of changing
the value of `foo'."
(if (eq cons list)
(cdr list)
(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 "
Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
are saved as values of the `unknown' text-property \(which is list-valued).
The TRANSLATIONS list should usually contain an entry of the form
- \(unknown \(nil format-annotate-value))
+ (unknown (nil format-annotate-value))
to write these unknown annotations back into the file."
(save-excursion
(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))
Insert each element of the given LIST of buffer annotations at its
appropriate place. Use second arg OFFSET if the annotations' locations are
not relative to the beginning of the buffer: annotations will be inserted
-at their location-OFFSET+1 \(ie, the offset is treated as the position of
+at their location-OFFSET+1 \(i.e., the offset is treated as the position of
the first character in the buffer)."
(if (not offset)
(setq offset 0)
(setq l (cdr l)))))
(defun format-annotate-value (old new)
- "Return OLD and NEW as a \(CLOSE . OPEN) annotation pair.
+ "Return OLD and NEW as a (CLOSE . OPEN) annotation pair.
Useful as a default function for TRANSLATIONS alist when the value of the text
property is the name of the annotation that you want to use, as it is for the
`unknown' text property."
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