]> code.delx.au - gnu-emacs/blobdiff - lisp/format.el
(timezone-parse-date): Match forms 1 and 2 first.
[gnu-emacs] / lisp / format.el
index 6942cfb3593fa3c8ed750e74c54efa90e1b7f1b0..ed70fa9d1c66ff61418a84646d0a0bf2934aecfe 100644 (file)
@@ -1,7 +1,8 @@
-;;; format.el -- read and save files in multiple formats
-;; Copyright (c) 1994 Free Software Foundation
+;;; format.el --- read and save files in multiple formats
 
-;; Author: Boris Goldowsky <boris@cs.rochester.edu>
+;; Copyright (c) 1994, 1995 Free Software Foundation
+
+;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
 
 ;; This file is part of GNU Emacs.
 
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
-;;
+
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
-;; This file defines a unified mechanism for saving & loading files stored in
-;; different formats.  `format-alist' contains information that directs
+
+;; This file defines a unified mechanism for saving & loading files stored
+;; in different formats.  `format-alist' contains information that directs
 ;; Emacs to call an encoding or decoding function when reading or writing
 ;; files that match certain conditions.  
 ;;
-;; When a file is visited, its format is determined by matching the beginning
-;; of the file against regular expressions stored in `format-alist'.  If this
-;; fails, you can manually translate the buffer using `format-decode-buffer'.
-;; In either case, the formats used are listed in the variable
-;; `buffer-file-format', and become the default format for saving the buffer.
-;; To save a buffer in a different format, change this variable, or use
-;; `format-write-file'.
+;; When a file is visited, its format is determined by matching the
+;; beginning of the file against regular expressions stored in
+;; `format-alist'.  If this fails, you can manually translate the buffer
+;; using `format-decode-buffer'.  In either case, the formats used are
+;; listed in the variable `buffer-file-format', and become the default
+;; format for saving the buffer.  To save a buffer in a different format,
+;; change this variable, or use `format-write-file'.
 ;;
 ;; Auto-save files are normally created in the same format as the visited
-;; file, but the variable `auto-save-file-format' can be set to a particularly
-;; fast or otherwise preferred format to be used for auto-saving (or nil to do
-;; no encoding on auto-save files, but then you risk losing any
-;; text-properties in the buffer).
+;; file, but the variable `auto-save-file-format' can be set to a
+;; particularly fast or otherwise preferred format to be used for
+;; auto-saving (or nil to do no encoding on auto-save files, but then you
+;; risk losing any text-properties in the buffer).
 ;;
-;; You can manually translate a buffer into or out of a particular format with
-;; the functions `format-encode-buffer' and `format-decode-buffer'.
-;; To translate just the region use the functions `format-encode-region' and
-;; `format-decode-region'.  
+;; You can manually translate a buffer into or out of a particular format
+;; with the functions `format-encode-buffer' and `format-decode-buffer'.
+;; To translate just the region use the functions `format-encode-region'
+;; and `format-decode-region'.  
 ;;
-;; You can define a new format by writing the encoding and decoding functions,
-;; and adding an entry to `format-alist'.  See enriched.el for an example of
-;; how to implement a file format.  There are various functions defined
-;; in this file that may be useful for writing the encoding and decoding
-;; functions:
-;;  * `format-annotate-region' and `format-deannotate-region' allow a single
-;;     alist of information to be used for encoding and decoding.  The alist
-;;     defines a correspondence between strings in the file ("annotations")
-;;     and text-properties in the buffer.
+;; You can define a new format by writing the encoding and decoding
+;; functions, and adding an entry to `format-alist'.  See enriched.el for
+;; an example of how to implement a file format.  There are various
+;; functions defined in this file that may be useful for writing the
+;; encoding and decoding functions:
+;;  * `format-annotate-region' and `format-deannotate-region' allow a
+;;     single alist of information to be used for encoding and decoding.
+;;     The alist defines a correspondence between strings in the file
+;;     ("annotations") and text-properties in the buffer.
 ;;  * `format-replace-strings' is similarly useful for doing simple
 ;;     string->string translations in a reversible manner.
 
+;;; Code:
+
 (put 'buffer-file-format 'permanent-local t)
 
-(defconst format-alist 
+(defvar format-alist 
   '((text/enriched "Extended MIME text/enriched format."
                   "Content-[Tt]ype:[ \t]*text/enriched"
                   enriched-decode enriched-encode t enriched-mode)
@@ -78,20 +83,25 @@ 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.
-TO-FN   is called to encode a region into that format; it is also passed BEGIN
-        and END, and either returns a list of annotations like
-        `write-region-annotate-functions', or modifies the region and returns
-        the new end.
-MODIFY, if non-nil, means the TO-FN modifies the region.  If nil, TO-FN may
-        not make any changes and should return a list of annotations.
+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.
+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)
 
-(defun format-annotate-function (format from to)
+(defun format-annotate-function (format from to orig-buf)
   "Returns 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.
 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.
@@ -109,10 +119,10 @@ For most purposes, consider using `format-encode-region' instead."
              (copy-to-buffer copy-buf from to)
              (set-buffer copy-buf)
              (format-insert-annotations write-region-annotations-so-far from)
-             (funcall to-fn (point-min) (point-max))
+             (funcall to-fn (point-min) (point-max) orig-buf)
              nil)
          ;; Otherwise just call function, it will return annotations.
-         (funcall to-fn from to)))))
+         (funcall to-fn from to orig-buf)))))
 
 (defun format-decode (format length &optional visit-flag)
   ;; This function is called by insert-file-contents whenever a file is read.
@@ -227,8 +237,9 @@ one of the formats defined in `format-alist', or a list of such symbols."
              result)
         (if to-fn
             (if modify
-                (setq end (funcall to-fn beg end))
-              (format-insert-annotations (funcall to-fn beg end))))
+                (setq end (funcall to-fn beg end (current-buffer)))
+              (format-insert-annotations 
+               (funcall to-fn beg end (current-buffer)))))
         (setq format (cdr format)))))))
 
 (defun format-write-file (filename format)
@@ -251,6 +262,43 @@ name as FILE, to write a file of the same old name in that directory."
   (setq buffer-file-format format)
   (write-file filename))
 
+(defun format-find-file (filename format)
+  "Find the file FILE using data format FORMAT.
+If FORMAT is nil then do not do any format conversion."
+  (interactive
+   ;; Same interactive spec as write-file, plus format question.
+   (let* ((file (read-file-name "Find file: "))
+         (fmt (format-read (format "Read file `%s' in format: " 
+                                   (file-name-nondirectory file)))))
+     (list file fmt)))
+  (let ((format-alist nil))
+     (find-file filename))
+  (if format
+      (format-decode-buffer format)))
+
+(defun format-insert-file (filename format &optional beg end)
+  "Insert the contents of file FILE 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.
+   (let* ((file (read-file-name "Find file: "))
+         (fmt (format-read (format "Read file `%s' in format: " 
+                                   (file-name-nondirectory file)))))
+     (list file fmt)))
+  (let (value size)
+    (let ((format-alist nil))
+      (setq value (insert-file-contents filename nil beg end))
+      (setq size (nth 1 value)))
+    (if format
+       (setq size (format-decode size format)
+             value (cons (car value) size)))
+    value))
+
 (defun format-read (&optional prompt)
   "Read and return the name of a format.
 Return value is a list, like `buffer-file-format'; it may be nil.
@@ -431,7 +479,7 @@ to write these unknown annotations back into the file."
                  (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
-             ;; oneis closed.
+             ;; one is closed.
                (while (not found)
                  (let* ((top (car open-ans)) ; first on stack: should match.
                         (top-name (car top))
@@ -458,8 +506,21 @@ to write these unknown annotations back into the file."
                                                    (assoc r open-ans))
                                                  ans))
                                    nil ; multiple ans not satisfied
-                                 ;; Yes, use the current property name &
-                                 ;; value.  Set loop variables to nil so loop
+                                 ;; 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.
@@ -722,7 +783,7 @@ Annotations to open and to close are returned as a dotted pair."
 
 (defun format-annotate-atomic-property-change (prop-alist old new)
   "Internal function annotate a single property change.
-PROP-ALIST is the relevant segement of a TRANSLATIONS list.
+PROP-ALIST is the relevant segment of a TRANSLATIONS list.
 OLD and NEW are the values."
   (cond
    ;; Numerical annotation - use difference