MODE-FN, if specified, is called when visiting a file with that format.
It is called with a single positive argument, on the assumption
- that it turns on some Emacs mode.")
+ that it turns on some Emacs mode.
+
+PRESERVE, if non-nil, means that `format-write-file' should not remove
+ this format from `buffer-file-formats'.")
;;; Basic Functions (called from Lisp)
(if modify
;; To-function wants to modify region. Copy to safe place.
(let ((copy-buf (get-buffer-create (format " *Format Temp %d*"
- format-count))))
+ format-count)))
+ (sel-disp selective-display)
+ (multibyte enable-multibyte-characters)
+ (coding-system buffer-file-coding-system))
+ (with-current-buffer copy-buf
+ (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)
Second arg LENGTH is the number of characters following point to operate on.
If optional third arg VISIT-FLAG is true, set `buffer-file-format'
-to the list of formats used, and call any mode functions defined for those
-formats.
+to the reverted list of formats used, and call any mode functions defined
+for those formats.
Returns the new length of the decoded region.
(unwind-protect
(progn
;; Don't record undo information for the decoding.
-
+
(if (null format)
;; Figure out which format it is in, remember list in `format'.
(let ((try format-alist))
(if (and regexp (looking-at regexp)
(< (match-end 0) (+ begin length)))
(progn
- (setq format (cons (car f) format))
+ (push (car f) format)
;; Decode it
(if (nth 3 f)
(setq end (format-decode-run-method (nth 3 f) begin end)))
(setq end (format-decode-run-method (nth 3 f) begin end)))
;; Call visit function if required
(if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
- (setq do (cdr do)))))
+ (setq do (cdr do))))
+ ;; Encode in the opposite order.
+ (setq format (reverse format)))
(if visit-flag
(setq buffer-file-format format)))
-
+
(set-buffer-modified-p mod))
;; Return new length of region
(fmt (format-read (format "Write file `%s' in format: "
(file-name-nondirectory file)))))
(list file fmt)))
- (setq buffer-file-format format)
+ (let ((old-formats buffer-file-format)
+ preserve-formats)
+ (dolist (fmt old-formats)
+ (let ((aelt (assq fmt format-alist)))
+ (if (nth 7 aelt)
+ (push fmt preserve-formats))))
+ (setq buffer-file-format format)
+ (dolist (fmt preserve-formats)
+ (unless (memq fmt buffer-file-format)
+ (setq buffer-file-format (append buffer-file-format (list fmt))))))
(write-file filename))
(defun format-find-file (filename format)
;; Now (cdr p) is the cons to delete
(setcdr p (cdr cons))
list)))
-
+
(defun format-make-relatively-unique (a b)
"Delete common elements of lists A and B, return as pair.
Compares using `equal'."
Annotations listed under the pseudo-property PARAMETER are considered to be
arguments of the immediately surrounding annotation; the text between the
opening and closing parameter annotations is deleted from the buffer but saved
-as a string. The surrounding annotation should be listed under the
-pseudo-property FUNCTION. Instead of inserting a text-property for this
-annotation, the function listed in the VALUE slot is called to make whatever
-changes are appropriate. The function's first two arguments are the START and
-END locations, and the rest of the arguments are any PARAMETERs found in that
-region.
+as a string.
+
+The surrounding annotation should be listed under the pseudo-property
+FUNCTION. Instead of inserting a text-property for this annotation,
+the function listed in the VALUE slot is called to make whatever
+changes are appropriate. It can also return a list of the form
+\(START LOC PROP VALUE) which specifies a property to put on. The
+function's first two arguments are the START and END locations, and
+the rest of the arguments are any PARAMETERs found in that region.
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).
(delete-region loc end)
(cond
;; Positive annotations are stacked, remembering location
- (positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans)))
+ (positive (push `(,name ((,loc . nil))) open-ans))
;; It is a negative annotation:
;; Close the top annotation & add its text property.
;; If the file's nesting is messed up, the close might not match
;; Not a property, but a function.
(let ((rtn
(apply value start loc params)))
- (if rtn (setq todo (cons rtn todo)))))
+ (if rtn (push rtn todo))))
(t
;; Normal property/value pair
(setq todo
(cond
;; The minuend starts after the subtrahend ends; keep it.
((> (car m) (cdr s))
- (setq results (cons m results)
- minuend (cdr minuend)
+ (push m results)
+ (setq minuend (cdr minuend)
m (car minuend)))
;; The minuend extends beyond the end of the subtrahend. Chop it off.
((or (null (cdr m)) (> (cdr m) (cdr s)))
- (setq results (cons (cons (1+ (cdr s)) (cdr m)) results))
+ (push (cons (1+ (cdr s)) (cdr m)) results)
(setcdr m (cdr s)))
;; The subtrahend starts after the minuend ends; throw it away.
((< (cdr m) (car s))
(while (not (equal (car neg-ans) (car open-ans)))
;; To close anno. N, need to first close ans 1 to N-1,
;; remembering to re-open them later.
- (setq pos-ans (cons (car open-ans) pos-ans))
+ (push (car open-ans) pos-ans)
(setq all-ans
(cons (cons loc (funcall format-fn (car open-ans) nil))
all-ans))
;; Now remove the one we're really interested in from open list.
(setq open-ans (cdr open-ans))
;; And put the closing annotation here.
- (setq all-ans
- (cons (cons loc (funcall format-fn (car neg-ans) nil))
- all-ans)))
+ (push (cons loc (funcall format-fn (car neg-ans) nil))
+ all-ans))
(setq neg-ans (cdr neg-ans)))
;; Now deal with positive (opening) annotations
(let ((p pos-ans))
(while pos-ans
- (setq open-ans (cons (car pos-ans) open-ans))
- (setq all-ans
- (cons (cons loc (funcall format-fn (car pos-ans) t))
- all-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
(setq p before-plist)
(while p
(if (not (memq (car p) props))
- (setq props (cons (car p) props)))
+ (push (car p) props))
(setq p (cdr (cdr p))))
(setq p after-plist)
(while p
(if (not (memq (car p) props))
- (setq props (cons (car p) props)))
+ (push (car p) props))
(setq p (cdr (cdr p))))
(while props
- (setq prop (car props)
- props (cdr props))
+ (setq prop (pop props))
(if (memq prop ignore)
nil ; If it's been ignored before, ignore it now.
(let ((before (if all nil (car (cdr (memq prop before-plist)))))
(let ((result (format-annotate-single-property-change
prop before after translations)))
(if (not result)
- (setq not-found (cons prop not-found))
+ (push prop not-found)
(setq negatives (nconc negatives (car result))
positives (nconc positives (cdr result)))))))))
(vector negatives positives not-found)))