/[emacs]/emacs/lisp/format.el
ViewVC logotype

Diff of /emacs/lisp/format.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37 by rms, Tue Jun 11 19:26:45 2002 UTC revision 1.37.2.1 by miles, Fri Apr 4 06:20:05 2003 UTC
# Line 221  For most purposes, consider using `forma Line 221  For most purposes, consider using `forma
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)
# Line 241  for another match. Line 246  for another match.
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    
# Line 253  For most purposes, consider using `forma Line 258  For most purposes, consider using `forma
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))
# Line 264  For most purposes, consider using `forma Line 269  For most purposes, consider using `forma
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)))
# Line 286  For most purposes, consider using `forma Line 291  For most purposes, consider using `forma
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
# Line 479  the value of `foo'." Line 486  the value of `foo'."
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'."
# Line 608  to write these unknown annotations back Line 615  to write these unknown annotations back
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
# Line 688  to write these unknown annotations back Line 695  to write these unknown annotations back
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
# Line 753  yet known." Line 760  yet known."
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))
# Line 873  The same TRANSLATIONS structure can be u Line 880  The same TRANSLATIONS structure can be u
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))
# Line 881  The same TRANSLATIONS structure can be u Line 888  The same TRANSLATIONS structure can be u
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
# Line 932  either strings, or lists of the form (PA Line 937  either strings, or lists of the form (PA
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)))))
# Line 952  either strings, or lists of the form (PA Line 956  either strings, or lists of the form (PA
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)))

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.37.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26