221 |
(if modify |
(if modify |
222 |
;; To-function wants to modify region. Copy to safe place. |
;; To-function wants to modify region. Copy to safe place. |
223 |
(let ((copy-buf (get-buffer-create (format " *Format Temp %d*" |
(let ((copy-buf (get-buffer-create (format " *Format Temp %d*" |
224 |
format-count)))) |
format-count))) |
225 |
|
(sel-disp selective-display) |
226 |
|
(multibyte enable-multibyte-characters)) |
227 |
|
(with-current-buffer copy-buf |
228 |
|
(setq selective-display sel-disp) |
229 |
|
(set-buffer-multibyte multibyte)) |
230 |
(copy-to-buffer copy-buf from to) |
(copy-to-buffer copy-buf from to) |
231 |
(set-buffer copy-buf) |
(set-buffer copy-buf) |
232 |
(format-insert-annotations write-region-annotations-so-far from) |
(format-insert-annotations write-region-annotations-so-far from) |
246 |
|
|
247 |
Second arg LENGTH is the number of characters following point to operate on. |
Second arg LENGTH is the number of characters following point to operate on. |
248 |
If optional third arg VISIT-FLAG is true, set `buffer-file-format' |
If optional third arg VISIT-FLAG is true, set `buffer-file-format' |
249 |
to the list of formats used, and call any mode functions defined for those |
to the reverted list of formats used, and call any mode functions defined |
250 |
formats. |
for those formats. |
251 |
|
|
252 |
Returns the new length of the decoded region. |
Returns the new length of the decoded region. |
253 |
|
|
258 |
(unwind-protect |
(unwind-protect |
259 |
(progn |
(progn |
260 |
;; Don't record undo information for the decoding. |
;; Don't record undo information for the decoding. |
261 |
|
|
262 |
(if (null format) |
(if (null format) |
263 |
;; Figure out which format it is in, remember list in `format'. |
;; Figure out which format it is in, remember list in `format'. |
264 |
(let ((try format-alist)) |
(let ((try format-alist)) |
269 |
(if (and regexp (looking-at regexp) |
(if (and regexp (looking-at regexp) |
270 |
(< (match-end 0) (+ begin length))) |
(< (match-end 0) (+ begin length))) |
271 |
(progn |
(progn |
272 |
(setq format (cons (car f) format)) |
(push (car f) format) |
273 |
;; Decode it |
;; Decode it |
274 |
(if (nth 3 f) |
(if (nth 3 f) |
275 |
(setq end (format-decode-run-method (nth 3 f) begin end))) |
(setq end (format-decode-run-method (nth 3 f) begin end))) |
291 |
(setq end (format-decode-run-method (nth 3 f) begin end))) |
(setq end (format-decode-run-method (nth 3 f) begin end))) |
292 |
;; Call visit function if required |
;; Call visit function if required |
293 |
(if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) |
(if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) |
294 |
(setq do (cdr do))))) |
(setq do (cdr do)))) |
295 |
|
;; Encode in the opposite order. |
296 |
|
(setq format (reverse format))) |
297 |
(if visit-flag |
(if visit-flag |
298 |
(setq buffer-file-format format))) |
(setq buffer-file-format format))) |
299 |
|
|
300 |
(set-buffer-modified-p mod)) |
(set-buffer-modified-p mod)) |
301 |
|
|
302 |
;; Return new length of region |
;; Return new length of region |
486 |
;; Now (cdr p) is the cons to delete |
;; Now (cdr p) is the cons to delete |
487 |
(setcdr p (cdr cons)) |
(setcdr p (cdr cons)) |
488 |
list))) |
list))) |
489 |
|
|
490 |
(defun format-make-relatively-unique (a b) |
(defun format-make-relatively-unique (a b) |
491 |
"Delete common elements of lists A and B, return as pair. |
"Delete common elements of lists A and B, return as pair. |
492 |
Compares using `equal'." |
Compares using `equal'." |
615 |
(delete-region loc end) |
(delete-region loc end) |
616 |
(cond |
(cond |
617 |
;; Positive annotations are stacked, remembering location |
;; Positive annotations are stacked, remembering location |
618 |
(positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans))) |
(positive (push `(,name ((,loc . nil))) open-ans)) |
619 |
;; It is a negative annotation: |
;; It is a negative annotation: |
620 |
;; Close the top annotation & add its text property. |
;; Close the top annotation & add its text property. |
621 |
;; If the file's nesting is messed up, the close might not match |
;; If the file's nesting is messed up, the close might not match |
695 |
;; Not a property, but a function. |
;; Not a property, but a function. |
696 |
(let ((rtn |
(let ((rtn |
697 |
(apply value start loc params))) |
(apply value start loc params))) |
698 |
(if rtn (setq todo (cons rtn todo))))) |
(if rtn (push rtn todo)))) |
699 |
(t |
(t |
700 |
;; Normal property/value pair |
;; Normal property/value pair |
701 |
(setq todo |
(setq todo |
760 |
(cond |
(cond |
761 |
;; The minuend starts after the subtrahend ends; keep it. |
;; The minuend starts after the subtrahend ends; keep it. |
762 |
((> (car m) (cdr s)) |
((> (car m) (cdr s)) |
763 |
(setq results (cons m results) |
(push m results) |
764 |
minuend (cdr minuend) |
(setq minuend (cdr minuend) |
765 |
m (car minuend))) |
m (car minuend))) |
766 |
;; The minuend extends beyond the end of the subtrahend. Chop it off. |
;; The minuend extends beyond the end of the subtrahend. Chop it off. |
767 |
((or (null (cdr m)) (> (cdr m) (cdr s))) |
((or (null (cdr m)) (> (cdr m) (cdr s))) |
768 |
(setq results (cons (cons (1+ (cdr s)) (cdr m)) results)) |
(push (cons (1+ (cdr s)) (cdr m)) results) |
769 |
(setcdr m (cdr s))) |
(setcdr m (cdr s))) |
770 |
;; The subtrahend starts after the minuend ends; throw it away. |
;; The subtrahend starts after the minuend ends; throw it away. |
771 |
((< (cdr m) (car s)) |
((< (cdr m) (car s)) |
880 |
(while (not (equal (car neg-ans) (car open-ans))) |
(while (not (equal (car neg-ans) (car open-ans))) |
881 |
;; To close anno. N, need to first close ans 1 to N-1, |
;; To close anno. N, need to first close ans 1 to N-1, |
882 |
;; remembering to re-open them later. |
;; remembering to re-open them later. |
883 |
(setq pos-ans (cons (car open-ans) pos-ans)) |
(push (car open-ans) pos-ans) |
884 |
(setq all-ans |
(setq all-ans |
885 |
(cons (cons loc (funcall format-fn (car open-ans) nil)) |
(cons (cons loc (funcall format-fn (car open-ans) nil)) |
886 |
all-ans)) |
all-ans)) |
888 |
;; Now remove the one we're really interested in from open list. |
;; Now remove the one we're really interested in from open list. |
889 |
(setq open-ans (cdr open-ans)) |
(setq open-ans (cdr open-ans)) |
890 |
;; And put the closing annotation here. |
;; And put the closing annotation here. |
891 |
(setq all-ans |
(push (cons loc (funcall format-fn (car neg-ans) nil)) |
892 |
(cons (cons loc (funcall format-fn (car neg-ans) nil)) |
all-ans)) |
|
all-ans))) |
|
893 |
(setq neg-ans (cdr neg-ans))) |
(setq neg-ans (cdr neg-ans))) |
894 |
;; Now deal with positive (opening) annotations |
;; Now deal with positive (opening) annotations |
895 |
(let ((p pos-ans)) |
(let ((p pos-ans)) |
896 |
(while pos-ans |
(while pos-ans |
897 |
(setq open-ans (cons (car pos-ans) open-ans)) |
(push (car pos-ans) open-ans) |
898 |
(setq all-ans |
(push (cons loc (funcall format-fn (car pos-ans) t)) |
899 |
(cons (cons loc (funcall format-fn (car pos-ans) t)) |
all-ans) |
|
all-ans)) |
|
900 |
(setq pos-ans (cdr pos-ans)))))) |
(setq pos-ans (cdr pos-ans)))))) |
901 |
|
|
902 |
;; Close any annotations still open |
;; Close any annotations still open |
937 |
(setq p before-plist) |
(setq p before-plist) |
938 |
(while p |
(while p |
939 |
(if (not (memq (car p) props)) |
(if (not (memq (car p) props)) |
940 |
(setq props (cons (car p) props))) |
(push (car p) props)) |
941 |
(setq p (cdr (cdr p)))) |
(setq p (cdr (cdr p)))) |
942 |
(setq p after-plist) |
(setq p after-plist) |
943 |
(while p |
(while p |
944 |
(if (not (memq (car p) props)) |
(if (not (memq (car p) props)) |
945 |
(setq props (cons (car p) props))) |
(push (car p) props)) |
946 |
(setq p (cdr (cdr p)))) |
(setq p (cdr (cdr p)))) |
947 |
|
|
948 |
(while props |
(while props |
949 |
(setq prop (car props) |
(setq prop (pop props)) |
|
props (cdr props)) |
|
950 |
(if (memq prop ignore) |
(if (memq prop ignore) |
951 |
nil ; If it's been ignored before, ignore it now. |
nil ; If it's been ignored before, ignore it now. |
952 |
(let ((before (if all nil (car (cdr (memq prop before-plist))))) |
(let ((before (if all nil (car (cdr (memq prop before-plist))))) |
956 |
(let ((result (format-annotate-single-property-change |
(let ((result (format-annotate-single-property-change |
957 |
prop before after translations))) |
prop before after translations))) |
958 |
(if (not result) |
(if (not result) |
959 |
(setq not-found (cons prop not-found)) |
(push prop not-found) |
960 |
(setq negatives (nconc negatives (car result)) |
(setq negatives (nconc negatives (car result)) |
961 |
positives (nconc positives (cdr result))))))))) |
positives (nconc positives (cdr result))))))))) |
962 |
(vector negatives positives not-found))) |
(vector negatives positives not-found))) |