X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d0fc7e3b955d6fba36bef78d23a8b07b6b5a9e41..4532ac55a9f3f87863a4eb658845afa525fef410:/lisp/format.el diff --git a/lisp/format.el b/lisp/format.el index d5b4c859d8..97818c79ef 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -140,7 +140,10 @@ MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil, 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) @@ -218,7 +221,14 @@ For most purposes, consider using `format-encode-region' instead." (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) @@ -238,8 +248,8 @@ for another match. 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. @@ -250,7 +260,7 @@ For most purposes, consider using `format-decode-region' instead." (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)) @@ -261,7 +271,7 @@ For most purposes, consider using `format-decode-region' instead." (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))) @@ -283,10 +293,12 @@ For most purposes, consider using `format-decode-region' instead." (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 @@ -371,7 +383,16 @@ name as FILENAME, to write a file of the same old name in that directory." (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) @@ -467,7 +488,7 @@ the value of `foo'." ;; 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'." @@ -565,12 +586,15 @@ the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase). 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). @@ -593,7 +617,7 @@ to write these unknown annotations back into the file." (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 @@ -673,7 +697,7 @@ to write these unknown annotations back into the file." ;; 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 @@ -738,12 +762,12 @@ yet known." (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)) @@ -858,7 +882,7 @@ The same TRANSLATIONS structure can be used in reverse for reading files." (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)) @@ -866,17 +890,15 @@ The same TRANSLATIONS structure can be used in reverse for reading files." ;; 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 @@ -917,17 +939,16 @@ either strings, or lists of the form (PARAMETER VALUE)." (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))))) @@ -937,7 +958,7 @@ either strings, or lists of the form (PARAMETER VALUE)." (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)))