comparison lisp/format.el @ 90573:858cb33ae39d

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 357-381) - Merge from gnus--rel--5.10 - Update from CVS - Merge from erc--emacs--21 * gnus--rel--5.10 (patch 116-122) - Update from CVS - Merge from emacs--devo--0 Revision: [e-mail]/emacs--unicode--0--patch-98

90572:ab9b8d043c39

        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.  Use nil to avoid
        matching at all for formats for which this isn't appropriate to
        require explicit encoding/decoding.

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.

        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.
         It is called with a single positive argument, on the assumption
         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)

(defun format-encode-run-method (method from to &optional buffer)
  "Translate using function or shell script METHOD the text from FROM to TO.
If METHOD is a string, it is a shell command;
otherwise, it should be a Lisp function.
BUFFER should be the buffer that the output originally came from."
  (if (stringp method)
      (let ((error-buff (get-buffer-create "*Format Errors*"))
	    (coding-system-for-read 'no-conversion)

	  (switch-to-buffer-other-window error-buff)
	  (error "Format encoding failed")))
    (funcall method from to buffer)))

(defun format-decode-run-method (method from to &optional buffer)
  "Decode using function or shell script METHOD the text from FROM to TO.
If METHOD is a string, it is a shell command; otherwise, it should be
a Lisp function.  Decoding is done for the given BUFFER."
  (if (stringp method)
      (let ((error-buff (get-buffer-create "*Format Errors*"))
	    (coding-system-for-write 'no-conversion)
	    format-alist)
	(with-current-buffer error-buff

	(point))
    (funcall method from to)))

(defun format-annotate-function (format from to orig-buf format-count)
  "Return annotations for writing region as FORMAT.
FORMAT is a symbol naming one of the formats defined in `format-alist',
it must be a single symbol, not a list like `buffer-file-format'.
FROM and TO delimit the region to be operated on in the current buffer.
ORIG-BUF is the original buffer that the data came from.

FORMAT-COUNT is an integer specifying how many times this function has
been called in the process of decoding ORIG-BUF.

This function works like a function on `write-region-annotate-functions':
it either returns a list of annotations, or returns with a different buffer
current, which contains the modified text to write.  In the latter case,
this function's value is nil.

For most purposes, consider using `format-encode-region' instead."

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 reverted list of formats used, and call any mode functions defined
for those formats.

Returns the new length of the decoded region.

For most purposes, consider using `format-decode-region' instead."
  (let ((mod (buffer-modified-p))
	(begin (point))
	(end (+ (point) length)))

;;; Interactive functions & entry points
;;;

(defun format-decode-buffer (&optional format)
  "Translate the buffer from some FORMAT.
If the format is not specified, this function attempts to guess.
`buffer-file-format' is set to the format used, and any mode-functions
for the format are called."
  (interactive
   (list (format-read "Translate buffer from format (default guess): ")))
  (save-excursion
    (goto-char (point-min))
    (format-decode format (buffer-size) t)))

			      buffer-file-format))))
  (format-encode-region (point-min) (point-max) format))

(defun format-encode-region (beg end &optional format)
  "Translate the region into some FORMAT.
FORMAT defaults to `buffer-file-format', it is a symbol naming
one of the formats defined in `format-alist', or a list of such symbols."
  (interactive
   (list (region-beginning) (region-end)
	 (format-read (format "Translate region to format (default %s): "
			      buffer-file-format))))

  "Write current buffer into file FILENAME using some FORMAT.
Make buffer visit that file and set the format as the default for future
saves.  If the buffer is already visiting a file, you can specify a directory
name as FILENAME, to write a file of the same old name in that directory.

If optional third arg CONFIRM is non-nil, this function asks for
confirmation before overwriting an existing file.  Interactively,
confirmation is required unless you supply a prefix argument."
  (interactive
   ;; Same interactive spec as write-file, plus format question.
   (let* ((file (if buffer-file-name
		    (read-file-name "Write file: "
				    nil nil nil nil)

(defun format-insert-file (filename format &optional beg end)
  "Insert the contents of file FILENAME using data format FORMAT.
If FORMAT is nil then do not do any format conversion.
The optional third and fourth arguments BEG and END specify
the part of the file to read.

The return value is like the value of `insert-file-contents':
a list (ABSOLUTE-FILE-NAME SIZE)."
  (interactive
   ;; Same interactive spec as write-file, plus format question.

;;;

(defun format-replace-strings (alist &optional reverse beg end)
  "Do multiple replacements on the buffer.
ALIST is a list of (FROM . TO) pairs, which should be proper arguments to
`search-forward' and `replace-match' respectively.
Optional 2nd arg REVERSE, if non-nil, means the pairs are (TO . FROM), so that
you can use the same list in both directions if it contains only literal
strings.
Optional args BEG and END specify a region of the buffer on which to operate."
  (save-excursion
    (save-restriction
      (or beg (setq beg (point-min)))
      (if end (narrow-to-region (point-min) end))

      (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'."
  (let* ((acopy (copy-sequence a))
	 (bcopy (copy-sequence b))
	 (tail acopy))
    (while tail
      (let ((dup (member (car tail) bcopy))

	(setq tail next)))
    (cons acopy bcopy)))

(defun format-common-tail (a b)
  "Given two lists that have a common tail, return it.
Compares with `equal', and returns the part of A that is equal to the
equivalent part of B.  If even the last items of the two are not equal,
returns nil."
  (let ((la (length a))
	(lb (length b)))
    ;; Make sure they are the same length
    (if (> la lb)
	(setq a (nthcdr (- la lb) a))

    (while (consp list)
      (setq list (cdr list)))
    (null list)))

(defun format-reorder (items order)
  "Arrange ITEMS to following partial ORDER.
Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
ORDER.  Unmatched items will go last."
  (if order
      (let ((item (member (car order) items)))
	(if item
	    (cons (car item)
		  (format-reorder (format-delq-cons item items)

;; 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)
  "Over the region between FROM and TO increment property PROP by amount DELTA.
DELTA 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)

;;; Encoding
;;;

(defun format-insert-annotations (list &optional offset)
  "Apply list of annotations to buffer as `write-region' would.
Inserts each element of the given LIST of buffer annotations at its
appropriate place.  Use second arg OFFSET if the annotations' locations are
not relative to the beginning of the buffer: annotations will be inserted
at their location-OFFSET+1 \(ie, the offset is treated as the position of
the first character in the buffer)."
  (if (not offset)

  (cons (if old (list old))
	(if new (list new))))

(defun format-annotate-region (from to translations format-fn ignore)
  "Generate annotations for text properties in the region.
Searches for changes between FROM and TO, and describes them with a list of
annotations as defined by alist TRANSLATIONS and FORMAT-FN.  IGNORE lists text
properties not to consider; any text properties that are neither ignored nor
listed in TRANSLATIONS are warned about.
If you actually want to modify the region, give the return value of this
function to `format-insert-annotations'.

(defun format-annotate-single-property-change (prop old new translations)
  "Return annotations for property PROP changing from OLD to NEW.
These are searched for in the translations alist TRANSLATIONS
 (see `format-annotate-region' for the format).
If NEW does not appear in the list, but there is a default function, then that
function is called.
Returns a cons of the form (CLOSE . OPEN)
where CLOSE is a list of annotations to close
and OPEN is a list of annotations to open.

The annotations in CLOSE and OPEN need not be strings.
They can be whatever the FORMAT-FN in `format-annotate-region'

		      new (cdr new)))
	      (format-make-relatively-unique close open)))
	(format-annotate-atomic-property-change prop-alist old new)))))

(defun format-annotate-atomic-property-change (prop-alist old new)
  "Internal function annotate a single property change.
PROP-ALIST is the relevant element of a TRANSLATIONS list.
OLD and NEW are the values."
  (let (num-ann)
    ;; If old and new values are numbers,
    ;; look for a number in PROP-ALIST.

90573:858cb33ae39d

        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.  Use nil to avoid
        matching at all for formats for which it isn't appropriate to
        require explicit encoding/decoding.

FROM-FN is called to decode files in that format; it takes 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 takes 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.

        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.
         It is called with a single positive argument, on the assumption
         that this would turn on some minor mode.

PRESERVE, if non-nil, means that `format-write-file' should not remove
          this format from `buffer-file-formats'.")

;;; Basic Functions (called from Lisp)

(defun format-encode-run-method (method from to &optional buffer)
  "Translate using METHOD the text from FROM to TO.
If METHOD is a string, it is a shell command (including options);
otherwise, it should be a Lisp function.
BUFFER should be the buffer that the output originally came from."
  (if (stringp method)
      (let ((error-buff (get-buffer-create "*Format Errors*"))
	    (coding-system-for-read 'no-conversion)

	  (switch-to-buffer-other-window error-buff)
	  (error "Format encoding failed")))
    (funcall method from to buffer)))

(defun format-decode-run-method (method from to &optional buffer)
  "Decode using METHOD the text from FROM to TO.
If METHOD is a string, it is a shell command (including options); otherwise,
it should be a Lisp function.  Decoding is done for the given BUFFER."
  (if (stringp method)
      (let ((error-buff (get-buffer-create "*Format Errors*"))
	    (coding-system-for-write 'no-conversion)
	    format-alist)
	(with-current-buffer error-buff

	(point))
    (funcall method from to)))

(defun format-annotate-function (format from to orig-buf format-count)
  "Return annotations for writing region as FORMAT.
FORMAT is a symbol naming one of the formats defined in `format-alist'.
It must be a single symbol, not a list like `buffer-file-format'.
FROM and TO delimit the region to be operated on in the current buffer.
ORIG-BUF is the original buffer that the data came from.

FORMAT-COUNT is an integer specifying how many times this function has
been called in the process of decoding ORIG-BUF.

This function works like a function in `write-region-annotate-functions':
it either returns a list of annotations, or returns with a different buffer
current, which contains the modified text to write.  In the latter case,
this function's value is nil.

For most purposes, consider using `format-encode-region' instead."

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 reverted list of formats used, and call any mode functions defined
for those formats.

Return the new length of the decoded region.

For most purposes, consider using `format-decode-region' instead."
  (let ((mod (buffer-modified-p))
	(begin (point))
	(end (+ (point) length)))

;;; Interactive functions & entry points
;;;

(defun format-decode-buffer (&optional format)
  "Translate the buffer from some FORMAT.
If the format is not specified, attempt a regexp-based guess.
Set `buffer-file-format' to the format used, and call any
format-specific mode functions."
  (interactive
   (list (format-read "Translate buffer from format (default guess): ")))
  (save-excursion
    (goto-char (point-min))
    (format-decode format (buffer-size) t)))

			      buffer-file-format))))
  (format-encode-region (point-min) (point-max) format))

(defun format-encode-region (beg end &optional format)
  "Translate the region into some FORMAT.
FORMAT defaults to `buffer-file-format'.  It is a symbol naming
one of the formats defined in `format-alist', or a list of such symbols."
  (interactive
   (list (region-beginning) (region-end)
	 (format-read (format "Translate region to format (default %s): "
			      buffer-file-format))))

  "Write current buffer into file FILENAME using some FORMAT.
Make buffer visit that file and set the format as the default for future
saves.  If the buffer is already visiting a file, you can specify a directory
name as FILENAME, to write a file of the same old name in that directory.

If optional third arg CONFIRM is non-nil, ask for confirmation before
overwriting an existing file.  Interactively, confirmation is required
unless you supply a prefix argument."
  (interactive
   ;; Same interactive spec as write-file, plus format question.
   (let* ((file (if buffer-file-name
		    (read-file-name "Write file: "
				    nil nil nil nil)

(defun format-insert-file (filename format &optional beg end)
  "Insert the contents of file FILENAME using data format FORMAT.
If FORMAT is nil then do not do any format conversion.
The optional third and fourth arguments BEG and END specify
the part (in bytes) of the file to read.

The return value is like the value of `insert-file-contents':
a list (ABSOLUTE-FILE-NAME SIZE)."
  (interactive
   ;; Same interactive spec as write-file, plus format question.

;;;

(defun format-replace-strings (alist &optional reverse beg end)
  "Do multiple replacements on the buffer.
ALIST is a list of (FROM . TO) pairs, which should be proper arguments to
`search-forward' and `replace-match', respectively.
Optional second arg REVERSE, if non-nil, means the pairs are (TO . FROM),
so that you can use the same list in both directions if it contains only
literal strings.
Optional args BEG and END specify a region of the buffer on which to operate."
  (save-excursion
    (save-restriction
      (or beg (setq beg (point-min)))
      (if end (narrow-to-region (point-min) end))

      (setcdr p (cdr cons))
      list)))

(defun format-make-relatively-unique (a b)
  "Delete common elements of lists A and B, return as pair.
Compare using `equal'."
  (let* ((acopy (copy-sequence a))
	 (bcopy (copy-sequence b))
	 (tail acopy))
    (while tail
      (let ((dup (member (car tail) bcopy))

	(setq tail next)))
    (cons acopy bcopy)))

(defun format-common-tail (a b)
  "Given two lists that have a common tail, return it.
Compare with `equal', and return the part of A that is equal to the
equivalent part of B.  If even the last items of the two are not equal,
return nil."
  (let ((la (length a))
	(lb (length b)))
    ;; Make sure they are the same length
    (if (> la lb)
	(setq a (nthcdr (- la lb) a))

    (while (consp list)
      (setq list (cdr list)))
    (null list)))

(defun format-reorder (items order)
  "Arrange ITEMS to follow partial ORDER.
Elements of ITEMS equal to elements of ORDER will be rearranged
to follow the ORDER.  Unmatched items will go last."
  (if order
      (let ((item (member (car order) items)))
	(if item
	    (cons (car item)
		  (format-reorder (format-delq-cons item items)

;; 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)
  "In the region from FROM to TO increment property PROP by amount DELTA.
DELTA 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)

;;; Encoding
;;;

(defun format-insert-annotations (list &optional offset)
  "Apply list of annotations to buffer as `write-region' would.
Insert each element of the given LIST of buffer annotations at its
appropriate place.  Use second arg OFFSET if the annotations' locations are
not relative to the beginning of the buffer: annotations will be inserted
at their location-OFFSET+1 \(ie, the offset is treated as the position of
the first character in the buffer)."
  (if (not offset)

  (cons (if old (list old))
	(if new (list new))))

(defun format-annotate-region (from to translations format-fn ignore)
  "Generate annotations for text properties in the region.
Search for changes between FROM and TO, and describe them with a list of
annotations as defined by alist TRANSLATIONS and FORMAT-FN.  IGNORE lists text
properties not to consider; any text properties that are neither ignored nor
listed in TRANSLATIONS are warned about.
If you actually want to modify the region, give the return value of this
function to `format-insert-annotations'.

(defun format-annotate-single-property-change (prop old new translations)
  "Return annotations for property PROP changing from OLD to NEW.
These are searched for in the translations alist TRANSLATIONS
 (see `format-annotate-region' for the format).
If NEW does not appear in the list, but there is a default function,
then call that function.
Return a cons of the form (CLOSE . OPEN)
where CLOSE is a list of annotations to close
and OPEN is a list of annotations to open.

The annotations in CLOSE and OPEN need not be strings.
They can be whatever the FORMAT-FN in `format-annotate-region'

		      new (cdr new)))
	      (format-make-relatively-unique close open)))
	(format-annotate-atomic-property-change prop-alist old new)))))

(defun format-annotate-atomic-property-change (prop-alist old new)
  "Internal function to annotate a single property change.
PROP-ALIST is the relevant element of a TRANSLATIONS list.
OLD and NEW are the values."
  (let (num-ann)
    ;; If old and new values are numbers,
    ;; look for a number in PROP-ALIST.