nil nil nil nil nil)
(ibm "IBM Code Page 850 (DOS)"
"1\\(^\\)"
- "recode ibm-ps:latin1" "recode latin1:ibm-pc" t nil)
+ "recode -f ibm-pc:latin1" "recode -f latin1:ibm-pc" t nil)
(mac "Apple Macintosh"
"1\\(^\\)"
- "recode mac:latin1" "recode latin1:mac" t nil)
+ "recode -f mac:latin1" "recode -f latin1:mac" t nil)
(hp "HP Roman8"
"1\\(^\\)"
- "recode roman8:latin1" "recode latin1:roman8" t nil)
+ "recode -f roman8:latin1" "recode -f latin1:roman8" t nil)
(TeX "TeX (encoding)"
"1\\(^\\)"
iso-tex2iso iso-iso2tex t nil)
iso-gtex2iso iso-iso2gtex t nil)
(html "HTML (encoding)"
"1\\(^\\)"
- "recode html:latin1" "recode latin1:html" t nil)
+ "recode -f html:latin1" "recode -f latin1:html" t nil)
(rot13 "rot13"
"1\\(^\\)"
"tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil)
"diac" iso-iso2duden t nil)
(de646 "German ASCII (ISO 646)"
"1\\(^\\)"
- "recode iso646-ge:latin1" "recode latin1:iso646-ge" t nil)
+ "recode -f iso646-ge:latin1" "recode -f latin1:iso646-ge" t nil)
(denet "net German"
"1\\(^\\)"
iso-german iso-cvt-read-only t nil)
iso-spanish iso-cvt-read-only t nil))
"List of information about understood file formats.
Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN).
+
NAME is a symbol, which is stored in `buffer-file-format'.
+
DOC-STR should be a single line providing more information about the
format. It is currently unused, but in the future will be shown to
the user if they ask for more information.
+
REGEXP is a regular expression to match against the beginning of the file;
it should match only files in that format.
+
FROM-FN is called to decode files in that format; it gets two args, BEGIN
and END, and can make any modifications it likes, returning the new
end. It must make sure that the beginning of the file no longer
matches REGEXP, or else it will get called again.
+ Alternatively, FROM-FN can be a string, which specifies a shell command
+ (including options) to be used as a filter to perform the conversion.
+
TO-FN is called to encode a region into that format; it is passed three
arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that
the data being written came from, which the function could use, for
example, to find the values of local variables. TO-FN should either
return a list of annotations like `write-region-annotate-functions',
or modify the region and return the new end.
+ Alternatively, TO-FN can be a string, which specifies a shell command
+ (including options) to be used as a filter to perform the conversion.
+
MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil,
TO-FN will not make any changes but will instead return a list of
annotations.
+
MODE-FN, if specified, is called when visiting a file with that format.")
;;; Basic Functions (called from Lisp)
(if (stringp method)
(save-current-buffer
(set-buffer buffer)
- (shell-command-on-region from to method t)
+ (with-output-to-temp-buffer "*Format Errors*"
+ (shell-command-on-region from to method t nil standard-output))
(point))
(funcall method from to buffer)))
otherwise, it should be a Lisp function."
(if (stringp method)
(progn
- (shell-command-on-region from to method t)
+ (with-output-to-temp-buffer "*Format Errors*"
+ (shell-command-on-region from to method t nil standard-output))
(point))
(funcall method from to)))
;; Delete the annotation
(delete-region loc end)
- (if positive
- ;; Positive annotations are stacked, remembering location
- (setq open-ans (cons (list name loc) 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
- ;; the top thing on the open-annotations stack.
- ;; If no matching annotation is open, just ignore the close.
- (if (not (assoc name open-ans))
- (message "Extra closing annotation (%s) in file" name)
- ;; If one is open, but not on the top of the stack, close
- ;; the things in between as well. Set `found' when the real
- ;; one is closed.
- (while (not found)
- (let* ((top (car open-ans)) ; first on stack: should match.
- (top-name (car top))
- (start (car (cdr top))) ; location of start
- (params (cdr (cdr top))) ; parameters
- (aalist translations)
- (matched nil))
- (if (equal name top-name)
- (setq found t)
- (message "Improper nesting in file."))
- ;; Look through property names in TRANSLATIONS
- (while aalist
- (let ((prop (car (car aalist)))
- (alist (cdr (car aalist))))
- ;; And look through values for each property
- (while alist
- (let ((value (car (car alist)))
- (ans (cdr (car alist))))
- (if (member top-name ans)
- ;; This annotation is listed, but still have to
- ;; check if multiple annotations are satisfied
- (if (member 'nil (mapcar
- (lambda (r)
- (assoc r open-ans))
- ans))
- nil ; multiple ans not satisfied
- ;; Yes, all set.
- ;; If there are multiple annotations going
- ;; into one text property, adjust the
- ;; begin points of the other annotations
- ;; so that we don't get double marking.
- (let ((to-reset ans)
- this-one)
- (while to-reset
- (setq this-one
- (assoc (car to-reset)
- (cdr open-ans)))
- (if this-one
- (setcar (cdr this-one) loc))
- (setq to-reset (cdr to-reset))))
- ;; Set loop variables to nil so loop
- ;; will exit.
- (setq alist nil aalist nil matched t
- ;; pop annotation off stack.
- open-ans (cdr open-ans))
- (cond
- ;; Check for pseudo-properties
- ((eq prop 'PARAMETER)
- ;; This is a parameter of the top open ann:
- ;; delete text and use as arg.
- (if open-ans
- ;; (If nothing open, discard).
- (setq open-ans
- (cons (append (car open-ans)
- (list
- (buffer-substring
- start loc)))
- (cdr open-ans))))
- (delete-region start loc))
- ((eq prop 'FUNCTION)
- ;; Not a property, but a function to call.
- (let ((rtn (apply value start loc params)))
- (if rtn (setq todo (cons rtn todo)))))
- (t
- ;; Normal property/value pair
- (setq todo
- (cons (list start loc prop value)
- todo)))))))
- (setq alist (cdr alist))))
- (setq aalist (cdr aalist)))
- (if matched
- nil
+ (cond
+ ;; Positive annotations are stacked, remembering location
+ (positive (setq open-ans (cons `(,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
+ ;; the top thing on the open-annotations stack.
+ ;; If no matching annotation is open, just ignore the close.
+ ((not (assoc name open-ans))
+ (message "Extra closing annotation (%s) in file" name))
+ ;; If one is open, but not on the top of the stack, close
+ ;; the things in between as well. Set `found' when the real
+ ;; one is closed.
+ (t
+ (while (not found)
+ (let* ((top (car open-ans)) ; first on stack: should match.
+ (top-name (car top)) ; text property name
+ (top-extents (nth 1 top)) ; property regions
+ (params (cdr (cdr top))) ; parameters
+ (aalist translations)
+ (matched nil))
+ (if (equal name top-name)
+ (setq found t)
+ (message "Improper nesting in file."))
+ ;; Look through property names in TRANSLATIONS
+ (while aalist
+ (let ((prop (car (car aalist)))
+ (alist (cdr (car aalist))))
+ ;; And look through values for each property
+ (while alist
+ (let ((value (car (car alist)))
+ (ans (cdr (car alist))))
+ (if (member top-name ans)
+ ;; This annotation is listed, but still have to
+ ;; check if multiple annotations are satisfied
+ (if (member nil (mapcar (lambda (r)
+ (assoc r open-ans))
+ ans))
+ nil ; multiple ans not satisfied
+ ;; If there are multiple annotations going
+ ;; into one text property, split up the other
+ ;; annotations so they apply individually to
+ ;; the other regions.
+ (setcdr (car top-extents) loc)
+ (let ((to-split ans) this-one extents)
+ (while to-split
+ (setq this-one
+ (assoc (car to-split) open-ans)
+ extents (nth 1 this-one))
+ (if (not (eq this-one top))
+ (setcar (cdr this-one)
+ (format-subtract-regions
+ extents top-extents)))
+ (setq to-split (cdr to-split))))
+ ;; Set loop variables to nil so loop
+ ;; will exit.
+ (setq alist nil aalist nil matched t
+ ;; pop annotation off stack.
+ open-ans (cdr open-ans))
+ (let ((extents top-extents)
+ (start (car (car top-extents)))
+ (loc (cdr (car top-extents))))
+ (while extents
+ (cond
+ ;; Check for pseudo-properties
+ ((eq prop 'PARAMETER)
+ ;; A parameter of the top open ann:
+ ;; delete text and use as arg.
+ (if open-ans
+ ;; (If nothing open, discard).
+ (setq open-ans
+ (cons
+ (append (car open-ans)
+ (list
+ (buffer-substring
+ start loc)))
+ (cdr open-ans))))
+ (delete-region start loc))
+ ((eq prop 'FUNCTION)
+ ;; Not a property, but a function.
+ (let ((rtn
+ (apply value start loc params)))
+ (if rtn (setq todo (cons rtn todo)))))
+ (t
+ ;; Normal property/value pair
+ (setq todo
+ (cons (list start loc prop value)
+ todo))))
+ (setq extents (cdr extents)
+ start (car (car extents))
+ loc (cdr (car extents))))))))
+ (setq alist (cdr alist))))
+ (setq aalist (cdr aalist)))
+ (if (not matched)
;; Didn't find any match for the annotation:
;; Store as value of text-property `unknown'.
- (setq open-ans (cdr open-ans))
- (setq todo (cons (list start loc 'unknown top-name)
- todo))
- (setq unknown-ans (cons name unknown-ans)))))))))
+ (let ((extents top-extents)
+ (start (car (car top-extents)))
+ (loc (or (cdr (car top-extents)) loc)))
+ (while extents
+ (setq open-ans (cdr open-ans)
+ todo (cons (list start loc 'unknown top-name)
+ todo)
+ unknown-ans (cons name unknown-ans)
+ extents (cdr extents)
+ start (car (car extents))
+ loc (cdr (car extents))))))))))))
;; Once entire file has been scanned, add the properties.
(while todo
(to (nth 1 item))
(prop (nth 2 item))
(val (nth 3 item)))
-
- (put-text-property
+
+ (if (numberp val) ; add to ambient value if numeric
+ (format-property-increment-region from to prop val 0)
+ (put-text-property
from to prop
- (cond ((numberp val) ; add to ambient value if numeric
- (+ val (or (get-text-property from prop) 0)))
- ((get prop 'format-list-valued) ; value gets consed onto
+ (cond ((get prop 'format-list-valued) ; value gets consed onto
; list-valued properties
(let ((prev (get-text-property from prop)))
(cons val (if (listp prev) prev (list prev)))))
- (t val)))) ; normally, just set to val.
+ (t val))))) ; normally, just set to val.
(setq todo (cdr todo)))
-
+
(if unknown-ans
(message "Unknown annotations: %s" unknown-ans))))))
+(defun format-subtract-regions (minu subtra)
+ "Remove the regions in SUBTRAHEND from the regions in MINUEND. A region
+is a dotted pair (from . to). Both parameters are lists of regions. Each
+list must contain nonoverlapping, noncontiguous regions, in descending
+order. The result is also nonoverlapping, noncontiguous, and in descending
+order. The first element of MINUEND can have a cdr of nil, indicating that
+the end of that region is not yet known."
+ (let* ((minuend (copy-alist minu))
+ (subtrahend (copy-alist subtra))
+ (m (car minuend))
+ (s (car subtrahend))
+ results)
+ (while (and minuend subtrahend)
+ (cond
+ ;; The minuend starts after the subtrahend ends; keep it.
+ ((> (car m) (cdr s))
+ (setq results (cons m results)
+ 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))
+ (setcdr m (cdr s)))
+ ;; The subtrahend starts after the minuend ends; throw it away.
+ ((< (cdr m) (car s))
+ (setq subtrahend (cdr subtrahend) s (car subtrahend)))
+ ;; The subtrahend extends beyond the end of the minuend. Chop it off.
+ (t ;(<= (cdr m) (cdr s)))
+ (if (>= (car m) (car s))
+ (setq minuend (cdr minuend) m (car minuend))
+ (setcdr m (1- (car s)))
+ (setq subtrahend (cdr subtrahend) s (car subtrahend))))))
+ (nconc (nreverse results) minuend)))
+
+;; This should probably go somewhere other than format.el. Then again,
+;; indent.el has alter-text-property. NOTE: We can also use
+;; next-single-property-change instead of text-property-not-all, but then
+;; we have to see if we passed TO.
+(defun format-property-increment-region (from to prop delta default)
+ "Increment property PROP over the region between FROM and TO by the
+amount DELTA (which may be negative). If property PROP is nil anywhere
+in the region, it is treated as though it were DEFAULT."
+ (let ((cur from) val newval next)
+ (while cur
+ (setq val (get-text-property cur prop)
+ newval (+ (or val default) delta)
+ next (text-property-not-all cur to prop val))
+ (put-text-property cur (or next to) prop newval)
+ (setq cur next))))
+
;;;
;;; Encoding
;;;
(setq num-ann (cdr num-ann)))))
(if num-ann
;; Numerical annotation - use difference
-
- ;; If property is numeric, nil means 0
- (cond ((and (numberp old) (null new))
- (setq new 0))
- ((and (numberp new) (null old))
- (setq old 0)))
-
- (let* ((entry (car num-ann))
- (increment (car entry))
- (n (ceiling (/ (float (- new old)) (float increment))))
- (anno (car (cdr entry))))
- (if (> n 0)
- (cons nil (make-list n anno))
- (cons (make-list (- n) anno) nil)))
+ (progn
+ ;; If property is numeric, nil means 0
+ (cond ((and (numberp old) (null new))
+ (setq new 0))
+ ((and (numberp new) (null old))
+ (setq old 0)))
+
+ (let* ((entry (car num-ann))
+ (increment (car entry))
+ (n (ceiling (/ (float (- new old)) (float increment))))
+ (anno (car (cdr entry))))
+ (if (> n 0)
+ (cons nil (make-list n anno))
+ (cons (make-list (- n) anno) nil))))
;; Standard annotation
(let ((close (and old (cdr (assoc old prop-alist))))