428
+ − 1 ;;; format.el --- read and save files in multiple formats
+ − 2
+ − 3 ;; Copyright (c) 1994, 1995, 1997 Free Software Foundation
+ − 4
+ − 5 ;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
+ − 6 ;; Keywords: extensions, dumped
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 23 ;; 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: Emacs 20.2.
+ − 26
+ − 27 ;;; Commentary:
+ − 28
+ − 29 ;; This file is dumped with XEmacs.
+ − 30
+ − 31 ;; This file defines a unified mechanism for saving & loading files stored
+ − 32 ;; in different formats. `format-alist' contains information that directs
+ − 33 ;; Emacs to call an encoding or decoding function when reading or writing
+ − 34 ;; files that match certain conditions.
+ − 35 ;;
+ − 36 ;; When a file is visited, its format is determined by matching the
+ − 37 ;; beginning of the file against regular expressions stored in
+ − 38 ;; `format-alist'. If this fails, you can manually translate the buffer
+ − 39 ;; using `format-decode-buffer'. In either case, the formats used are
+ − 40 ;; listed in the variable `buffer-file-format', and become the default
+ − 41 ;; format for saving the buffer. To save a buffer in a different format,
+ − 42 ;; change this variable, or use `format-write-file'.
+ − 43 ;;
+ − 44 ;; Auto-save files are normally created in the same format as the visited
+ − 45 ;; file, but the variable `auto-save-file-format' can be set to a
+ − 46 ;; particularly fast or otherwise preferred format to be used for
+ − 47 ;; auto-saving (or nil to do no encoding on auto-save files, but then you
+ − 48 ;; risk losing any text-properties in the buffer).
+ − 49 ;;
+ − 50 ;; You can manually translate a buffer into or out of a particular format
+ − 51 ;; with the functions `format-encode-buffer' and `format-decode-buffer'.
+ − 52 ;; To translate just the region use the functions `format-encode-region'
+ − 53 ;; and `format-decode-region'.
+ − 54 ;;
+ − 55 ;; You can define a new format by writing the encoding and decoding
+ − 56 ;; functions, and adding an entry to `format-alist'. See enriched.el for
+ − 57 ;; an example of how to implement a file format. There are various
+ − 58 ;; functions defined in this file that may be useful for writing the
+ − 59 ;; encoding and decoding functions:
+ − 60 ;; * `format-annotate-region' and `format-deannotate-region' allow a
+ − 61 ;; single alist of information to be used for encoding and decoding.
+ − 62 ;; The alist defines a correspondence between strings in the file
+ − 63 ;; ("annotations") and text-properties in the buffer.
+ − 64 ;; * `format-replace-strings' is similarly useful for doing simple
+ − 65 ;; string->string translations in a reversible manner.
+ − 66
+ − 67 ;;; Code:
+ − 68
+ − 69 (put 'buffer-file-format 'permanent-local t)
+ − 70
+ − 71 (defvar format-alist
+ − 72 '(
+ − 73 ; (image/jpeg "JPEG image" "\377\330\377\340\000\020JFIF"
+ − 74 ; image-decode-jpeg nil t image-mode)
+ − 75 ; (image/gif "GIF image" "GIF8[79]"
+ − 76 ; image-decode-gif nil t image-mode)
+ − 77 ; (image/png "Portable Network Graphics" "\211PNG"
+ − 78 ; image-decode-png nil t image-mode)
+ − 79 ; (image/x-xpm "XPM image" "/\\* XPM \\*/"
+ − 80 ; image-decode-xpm nil t image-mode)
+ − 81
+ − 82 ; ;; TIFF files have lousy magic
+ − 83 ; (image/tiff "TIFF image" "II\\*\000"
+ − 84 ; image-decode-tiff nil t image-mode) ;; TIFF 6.0 big-endian
+ − 85 ; (image/tiff "TIFF image" "MM\000\\*"
+ − 86 ; image-decode-tiff nil t image-mode) ;; TIFF 6.0 little-endian
+ − 87
+ − 88 (text/enriched "Extended MIME text/enriched format."
+ − 89 "Content-[Tt]ype:[ \t]*text/enriched"
+ − 90 enriched-decode enriched-encode t enriched-mode)
+ − 91 (text/richtext "Extended MIME obsolete text/richtext format."
+ − 92 "Content-[Tt]ype:[ \t]*text/richtext"
+ − 93 richtext-decode richtext-encode t enriched-mode)
+ − 94 (plain "ISO 8859-1 standard format, no text properties."
+ − 95 ;; Plain only exists so that there is an obvious neutral choice in
+ − 96 ;; the completion list.
+ − 97 nil nil nil nil nil)
+ − 98 ;; (ibm "IBM Code Page 850 (DOS)"
+ − 99 ;; "1\\(^\\)"
+ − 100 ;; "recode ibm-pc:latin1" "recode latin1:ibm-pc" t nil)
+ − 101 ;; (mac "Apple Macintosh"
+ − 102 ;; "1\\(^\\)"
+ − 103 ;; "recode mac:latin1" "recode latin1:mac" t nil)
+ − 104 ;; (hp "HP Roman8"
+ − 105 ;; "1\\(^\\)"
+ − 106 ;; "recode roman8:latin1" "recode latin1:roman8" t nil)
+ − 107 ;; (TeX "TeX (encoding)"
+ − 108 ;; "1\\(^\\)"
+ − 109 ;; iso-tex2iso iso-iso2tex t nil)
+ − 110 ;; (gtex "German TeX (encoding)"
+ − 111 ;; "1\\(^\\)"
+ − 112 ;; iso-gtex2iso iso-iso2gtex t nil)
+ − 113 ;; (html "HTML (encoding)"
+ − 114 ;; "1\\(^\\)"
+ − 115 ;; "recode html:latin1" "recode latin1:html" t nil)
+ − 116 ;; (rot13 "rot13"
+ − 117 ;; "1\\(^\\)"
+ − 118 ;; "tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil)
+ − 119 ;; (duden "Duden Ersatzdarstellung"
+ − 120 ;; "1\\(^\\)"
+ − 121 ;; "diac" iso-iso2duden t nil)
+ − 122 ;; (de646 "German ASCII (ISO 646)"
+ − 123 ;; "1\\(^\\)"
+ − 124 ;; "recode iso646-ge:latin1" "recode latin1:iso646-ge" t nil)
+ − 125 ;; (denet "net German"
+ − 126 ;; "1\\(^\\)"
+ − 127 ;; iso-german iso-cvt-read-only t nil)
+ − 128 ;; (esnet "net Spanish"
+ − 129 ;; "1\\(^\\)"
+ − 130 ;; iso-spanish iso-cvt-read-only t nil)
+ − 131 )
+ − 132 "List of information about understood file formats.
+ − 133 Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN).
+ − 134
+ − 135 NAME is a symbol, which is stored in `buffer-file-format'.
+ − 136
+ − 137 DOC-STR should be a single line providing more information about the
+ − 138 format. It is currently unused, but in the future will be shown to
+ − 139 the user if they ask for more information.
+ − 140
+ − 141 REGEXP is a regular expression to match against the beginning of the file;
+ − 142 it should match only files in that format.
+ − 143
+ − 144 FROM-FN is called to decode files in that format; it gets two args, BEGIN
+ − 145 and END, and can make any modifications it likes, returning the new
+ − 146 end. It must make sure that the beginning of the file no longer
+ − 147 matches REGEXP, or else it will get called again.
+ − 148 Alternatively, FROM-FN can be a string, which specifies a shell command
+ − 149 (including options) to be used as a filter to perform the conversion.
+ − 150
+ − 151 TO-FN is called to encode a region into that format; it is passed three
+ − 152 arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that
+ − 153 the data being written came from, which the function could use, for
+ − 154 example, to find the values of local variables. TO-FN should either
+ − 155 return a list of annotations like `write-region-annotate-functions',
+ − 156 or modify the region and return the new end.
+ − 157 Alternatively, TO-FN can be a string, which specifies a shell command
+ − 158 (including options) to be used as a filter to perform the conversion.
+ − 159
+ − 160 MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil,
+ − 161 TO-FN will not make any changes but will instead return a list of
+ − 162 annotations.
+ − 163
+ − 164 MODE-FN, if specified, is called when visiting a file with that format.")
+ − 165
+ − 166 ;;; Basic Functions (called from Lisp)
+ − 167
+ − 168 (defun format-encode-run-method (method from to &optional buffer)
+ − 169 "Translate using function or shell script METHOD the text from FROM to TO.
+ − 170 If METHOD is a string, it is a shell command;
+ − 171 otherwise, it should be a Lisp function.
+ − 172 BUFFER should be the buffer that the output originally came from."
+ − 173 (if (stringp method)
+ − 174 (save-current-buffer
+ − 175 (set-buffer buffer)
+ − 176 (with-output-to-temp-buffer "*Format Errors*"
+ − 177 (shell-command-on-region from to method t nil))
+ − 178 (point))
+ − 179 (funcall method from to buffer)))
+ − 180
+ − 181 (defun format-decode-run-method (method from to &optional buffer)
+ − 182 "Decode using function or shell script METHOD the text from FROM to TO.
+ − 183 If METHOD is a string, it is a shell command;
+ − 184 otherwise, it should be a Lisp function."
+ − 185 (if (stringp method)
+ − 186 (progn
+ − 187 (with-output-to-temp-buffer "*Format Errors*"
+ − 188 (shell-command-on-region from to method t nil))
+ − 189 (point))
+ − 190 (funcall method from to)))
+ − 191
+ − 192 (defun format-annotate-function (format from to orig-buf)
+ − 193 "Return annotations for writing region as FORMAT.
+ − 194 FORMAT is a symbol naming one of the formats defined in `format-alist',
+ − 195 it must be a single symbol, not a list like `buffer-file-format'.
+ − 196 FROM and TO delimit the region to be operated on in the current buffer.
+ − 197 ORIG-BUF is the original buffer that the data came from.
+ − 198 This function works like a function on `write-region-annotate-functions':
+ − 199 it either returns a list of annotations, or returns with a different buffer
+ − 200 current, which contains the modified text to write.
+ − 201
+ − 202 For most purposes, consider using `format-encode-region' instead."
+ − 203 ;; This function is called by write-region (actually build-annotations)
+ − 204 ;; for each element of buffer-file-format.
+ − 205 (let* ((info (assq format format-alist))
+ − 206 (to-fn (nth 4 info))
+ − 207 (modify (nth 5 info)))
+ − 208 (if to-fn
+ − 209 (if modify
+ − 210 ;; To-function wants to modify region. Copy to safe place.
+ − 211 (let ((copy-buf (get-buffer-create " *Format Temp*")))
+ − 212 (copy-to-buffer copy-buf from to)
+ − 213 (set-buffer copy-buf)
+ − 214 (format-insert-annotations write-region-annotations-so-far from)
+ − 215 (format-encode-run-method to-fn (point-min) (point-max) orig-buf)
+ − 216 nil)
+ − 217 ;; Otherwise just call function, it will return annotations.
+ − 218 (funcall to-fn from to orig-buf)))))
+ − 219
+ − 220 (defun format-decode (format length &optional visit-flag)
+ − 221 "Decode text from any known FORMAT.
+ − 222 FORMAT is a symbol appearing in `format-alist' or a list of such symbols,
+ − 223 or nil, in which case this function tries to guess the format of the data by
+ − 224 matching against the regular expressions in `format-alist'. After a match is
+ − 225 found and the region decoded, the alist is searched again from the beginning
+ − 226 for another match.
+ − 227
+ − 228 Second arg LENGTH is the number of characters following point to operate on.
+ − 229 If optional third arg VISIT-FLAG is true, set `buffer-file-format'
+ − 230 to the list of formats used, and call any mode functions defined for those
+ − 231 formats.
+ − 232
+ − 233 Returns the new length of the decoded region.
+ − 234
+ − 235 For most purposes, consider using `format-decode-region' instead.
+ − 236
+ − 237 This function is called by insert-file-contents whenever a file is read."
+ − 238 (let ((mod (buffer-modified-p))
+ − 239 (begin (point))
+ − 240 (end (+ (point) length)))
+ − 241 (if (null format)
+ − 242 ;; Figure out which format it is in, remember list in `format'.
+ − 243 (let ((try format-alist))
+ − 244 (while try
+ − 245 (let* ((f (car try))
+ − 246 (regexp (nth 2 f))
+ − 247 (p (point)))
+ − 248 (if (and regexp (looking-at regexp)
+ − 249 (< (match-end 0) (+ begin length)))
+ − 250 (progn
+ − 251 (setq format (cons (car f) format))
+ − 252 ;; Decode it
+ − 253 (if (nth 3 f)
+ − 254 (setq end (format-decode-run-method (nth 3 f) begin end)))
+ − 255 ;; Call visit function if required
+ − 256 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
+ − 257 ;; Safeguard against either of the functions changing pt.
+ − 258 (goto-char p)
+ − 259 ;; Rewind list to look for another format
+ − 260 (setq try format-alist))
+ − 261 (setq try (cdr try))))))
+ − 262 ;; Deal with given format(s)
+ − 263 (or (listp format) (setq format (list format)))
+ − 264 (let ((do format) f)
+ − 265 (while do
+ − 266 (or (setq f (assq (car do) format-alist))
+ − 267 (error "Unknown format" (car do)))
+ − 268 ;; Decode:
+ − 269 (if (nth 3 f)
+ − 270 (setq end (format-decode-run-method (nth 3 f) begin end)))
+ − 271 ;; Call visit function if required
+ − 272 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
+ − 273 (setq do (cdr do)))))
+ − 274 (if visit-flag
+ − 275 (setq buffer-file-format format))
+ − 276 (set-buffer-modified-p mod)
+ − 277 ;; Return new length of region
+ − 278 (- end begin)))
+ − 279
+ − 280 ;;;
+ − 281 ;;; Interactive functions & entry points
+ − 282 ;;;
+ − 283
+ − 284 (defun format-decode-buffer (&optional format)
+ − 285 "Translate the buffer from some FORMAT.
+ − 286 If the format is not specified, this function attempts to guess.
+ − 287 `buffer-file-format' is set to the format used, and any mode-functions
+ − 288 for the format are called."
+ − 289 (interactive
+ − 290 (list (format-read "Translate buffer from format (default: guess): ")))
+ − 291 (save-excursion
+ − 292 (goto-char (point-min))
+ − 293 (format-decode format (buffer-size) t)))
+ − 294
+ − 295 (defun format-decode-region (from to &optional format)
+ − 296 "Decode the region from some format.
+ − 297 Arg FORMAT is optional; if omitted the format will be determined by looking
+ − 298 for identifying regular expressions at the beginning of the region."
+ − 299 (interactive
+ − 300 (list (region-beginning) (region-end)
+ − 301 (format-read "Translate region from format (default: guess): ")))
+ − 302 (save-excursion
+ − 303 (goto-char from)
+ − 304 (format-decode format (- to from) nil)))
+ − 305
+ − 306 (defun format-encode-buffer (&optional format)
+ − 307 "Translate the buffer into FORMAT.
+ − 308 FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the
+ − 309 formats defined in `format-alist', or a list of such symbols."
+ − 310 (interactive
+ − 311 (list (format-read (format "Translate buffer to format (default %s): "
+ − 312 buffer-file-format))))
+ − 313 (format-encode-region (point-min) (point-max) format))
+ − 314
444
+ − 315 (defun format-encode-region (start end &optional format)
428
+ − 316 "Translate the region into some FORMAT.
+ − 317 FORMAT defaults to `buffer-file-format', it is a symbol naming
+ − 318 one of the formats defined in `format-alist', or a list of such symbols."
+ − 319 (interactive
+ − 320 (list (region-beginning) (region-end)
+ − 321 (format-read (format "Translate region to format (default %s): "
+ − 322 buffer-file-format))))
+ − 323 (if (null format) (setq format buffer-file-format))
+ − 324 (if (symbolp format) (setq format (list format)))
+ − 325 (save-excursion
+ − 326 (goto-char end)
+ − 327 (let ( ; (cur-buf (current-buffer))
+ − 328 (end (point-marker)))
+ − 329 (while format
+ − 330 (let* ((info (assq (car format) format-alist))
+ − 331 (to-fn (nth 4 info))
+ − 332 (modify (nth 5 info))
+ − 333 ;; result
+ − 334 )
+ − 335 (if to-fn
+ − 336 (if modify
444
+ − 337 (setq end (format-encode-run-method to-fn start end
428
+ − 338 (current-buffer)))
+ − 339 (format-insert-annotations
444
+ − 340 (funcall to-fn start end (current-buffer)))))
428
+ − 341 (setq format (cdr format)))))))
+ − 342
+ − 343 (defun format-write-file (filename format)
+ − 344 "Write current buffer into a FILE using some FORMAT.
+ − 345 Makes buffer visit that file and sets the format as the default for future
+ − 346 saves. If the buffer is already visiting a file, you can specify a directory
+ − 347 name as FILE, to write a file of the same old name in that directory."
+ − 348 (interactive
+ − 349 ;; Same interactive spec as write-file, plus format question.
+ − 350 (let* ((file (if buffer-file-name
+ − 351 (read-file-name "Write file: "
+ − 352 nil nil nil nil)
+ − 353 (read-file-name "Write file: "
+ − 354 (cdr (assq 'default-directory
+ − 355 (buffer-local-variables)))
+ − 356 nil nil (buffer-name))))
+ − 357 (fmt (format-read (format "Write file `%s' in format: "
+ − 358 (file-name-nondirectory file)))))
+ − 359 (list file fmt)))
+ − 360 (setq buffer-file-format format)
+ − 361 (write-file filename))
+ − 362
+ − 363 (defun format-find-file (filename format)
+ − 364 "Find the file FILE using data format FORMAT.
+ − 365 If FORMAT is nil then do not do any format conversion."
+ − 366 (interactive
+ − 367 ;; Same interactive spec as write-file, plus format question.
+ − 368 (let* ((file (read-file-name "Find file: "))
+ − 369 (fmt (format-read (format "Read file `%s' in format: "
+ − 370 (file-name-nondirectory file)))))
+ − 371 (list file fmt)))
+ − 372 (let ((format-alist nil))
+ − 373 (find-file filename))
+ − 374 (if format
+ − 375 (format-decode-buffer format)))
+ − 376
444
+ − 377 (defun format-insert-file (filename format &optional start end)
428
+ − 378 "Insert the contents of file FILE using data format FORMAT.
+ − 379 If FORMAT is nil then do not do any format conversion.
444
+ − 380 The optional third and fourth arguments START and END specify
428
+ − 381 the part of the file to read.
+ − 382
+ − 383 The return value is like the value of `insert-file-contents':
+ − 384 a list (ABSOLUTE-FILE-NAME . SIZE)."
+ − 385 (interactive
+ − 386 ;; Same interactive spec as write-file, plus format question.
+ − 387 (let* ((file (read-file-name "Find file: "))
+ − 388 (fmt (format-read (format "Read file `%s' in format: "
+ − 389 (file-name-nondirectory file)))))
+ − 390 (list file fmt)))
+ − 391 (let (value size)
+ − 392 (let ((format-alist nil))
444
+ − 393 (setq value (insert-file-contents filename nil start end))
428
+ − 394 (setq size (nth 1 value)))
+ − 395 (if format
+ − 396 (setq size (format-decode format size)
+ − 397 value (cons (car value) size)))
+ − 398 value))
+ − 399
+ − 400 (defun format-read (&optional prompt)
+ − 401 "Read and return the name of a format.
+ − 402 Return value is a list, like `buffer-file-format'; it may be nil.
+ − 403 Formats are defined in `format-alist'. Optional arg is the PROMPT to use."
+ − 404 (let* ((table (mapcar (lambda (x) (list (symbol-name (car x))))
+ − 405 format-alist))
+ − 406 (ans (completing-read (or prompt "Format: ") table nil t)))
+ − 407 (if (not (equal "" ans)) (list (intern ans)))))
+ − 408
+ − 409
+ − 410 ;;;
+ − 411 ;;; Below are some functions that may be useful in writing encoding and
+ − 412 ;;; decoding functions for use in format-alist.
+ − 413 ;;;
+ − 414
444
+ − 415 (defun format-replace-strings (alist &optional reverse start end)
428
+ − 416 "Do multiple replacements on the buffer.
+ − 417 ALIST is a list of (from . to) pairs, which should be proper arguments to
+ − 418 `search-forward' and `replace-match' respectively.
+ − 419 Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that
+ − 420 you can use the same list in both directions if it contains only literal
+ − 421 strings.
+ − 422 Optional args BEGIN and END specify a region of the buffer to operate on."
+ − 423 (save-excursion
+ − 424 (save-restriction
444
+ − 425 (or start (setq start (point-min)))
428
+ − 426 (if end (narrow-to-region (point-min) end))
+ − 427 (while alist
+ − 428 (let ((from (if reverse (cdr (car alist)) (car (car alist))))
+ − 429 (to (if reverse (car (cdr alist)) (cdr (car alist)))))
444
+ − 430 (goto-char start)
428
+ − 431 (while (search-forward from nil t)
+ − 432 (goto-char (match-beginning 0))
+ − 433 (insert to)
+ − 434 (set-text-properties (- (point) (length to)) (point)
+ − 435 (text-properties-at (point)))
+ − 436 (delete-region (point) (+ (point) (- (match-end 0)
+ − 437 (match-beginning 0)))))
+ − 438 (setq alist (cdr alist)))))))
+ − 439
+ − 440 ;;; Some list-manipulation functions that we need.
+ − 441
+ − 442 (defun format-delq-cons (cons list)
+ − 443 "Remove the given CONS from LIST by side effect,
+ − 444 and return the new LIST. Since CONS could be the first element
+ − 445 of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of
+ − 446 changing the value of `foo'."
+ − 447 (if (eq cons list)
+ − 448 (cdr list)
+ − 449 (let ((p list))
+ − 450 (while (not (eq (cdr p) cons))
+ − 451 (if (null p) (error "format-delq-cons: not an element."))
+ − 452 (setq p (cdr p)))
+ − 453 ;; Now (cdr p) is the cons to delete
+ − 454 (setcdr p (cdr cons))
+ − 455 list)))
+ − 456
+ − 457 (defun format-make-relatively-unique (a b)
+ − 458 "Delete common elements of lists A and B, return as pair.
+ − 459 Compares using `equal'."
+ − 460 (let* ((acopy (copy-sequence a))
+ − 461 (bcopy (copy-sequence b))
+ − 462 (tail acopy))
+ − 463 (while tail
+ − 464 (let ((dup (member (car tail) bcopy))
+ − 465 (next (cdr tail)))
+ − 466 (if dup (setq acopy (format-delq-cons tail acopy)
+ − 467 bcopy (format-delq-cons dup bcopy)))
+ − 468 (setq tail next)))
+ − 469 (cons acopy bcopy)))
+ − 470
+ − 471 (defun format-common-tail (a b)
+ − 472 "Given two lists that have a common tail, return it.
+ − 473 Compares with `equal', and returns the part of A that is equal to the
+ − 474 equivalent part of B. If even the last items of the two are not equal,
+ − 475 returns nil."
+ − 476 (let ((la (length a))
+ − 477 (lb (length b)))
+ − 478 ;; Make sure they are the same length
+ − 479 (if (> la lb)
+ − 480 (setq a (nthcdr (- la lb) a))
+ − 481 (setq b (nthcdr (- lb la) b))))
+ − 482 (while (not (equal a b))
+ − 483 (setq a (cdr a)
+ − 484 b (cdr b)))
+ − 485 a)
+ − 486
+ − 487 (defun format-reorder (items order)
+ − 488 "Arrange ITEMS to following partial ORDER.
+ − 489 Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
+ − 490 ORDER. Unmatched items will go last."
+ − 491 (if order
+ − 492 (let ((item (member (car order) items)))
+ − 493 (if item
+ − 494 (cons (car item)
+ − 495 (format-reorder (format-delq-cons item items)
+ − 496 (cdr order)))
+ − 497 (format-reorder items (cdr order))))
+ − 498 items))
+ − 499
+ − 500 (put 'face 'format-list-valued t) ; These text-properties take values
+ − 501 (put 'unknown 'format-list-valued t) ; that are lists, the elements of which
+ − 502 ; should be considered separately.
+ − 503 ; See format-deannotate-region and
+ − 504 ; format-annotate-region.
+ − 505
+ − 506 ;;;
+ − 507 ;;; Decoding
+ − 508 ;;;
+ − 509
+ − 510 (defun format-deannotate-region (from to translations next-fn)
+ − 511 "Translate annotations in the region into text properties.
+ − 512 This sets text properties between FROM to TO as directed by the
+ − 513 TRANSLATIONS and NEXT-FN arguments.
+ − 514
+ − 515 NEXT-FN is a function that searches forward from point for an annotation.
+ − 516 It should return a list of 4 elements: \(BEGIN END NAME POSITIVE). BEGIN and
+ − 517 END are buffer positions bounding the annotation, NAME is the name searched
+ − 518 for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks
+ − 519 the beginning of a region with some property, or nil if it ends the region.
+ − 520 NEXT-FN should return nil if there are no annotations after point.
+ − 521
+ − 522 The basic format of the TRANSLATIONS argument is described in the
+ − 523 documentation for the `format-annotate-region' function. There are some
+ − 524 additional things to keep in mind for decoding, though:
+ − 525
+ − 526 When an annotation is found, the TRANSLATIONS list is searched for a
+ − 527 text-property name and value that corresponds to that annotation. If the
+ − 528 text-property has several annotations associated with it, it will be used only
+ − 529 if the other annotations are also in effect at that point. The first match
+ − 530 found whose annotations are all present is used.
+ − 531
+ − 532 The text property thus determined is set to the value over the region between
+ − 533 the opening and closing annotations. However, if the text-property name has a
+ − 534 non-nil `format-list-valued' property, then the value will be consed onto the
+ − 535 surrounding value of the property, rather than replacing that value.
+ − 536
+ − 537 There are some special symbols that can be used in the \"property\" slot of
+ − 538 the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase).
+ − 539 Annotations listed under the pseudo-property PARAMETER are considered to be
+ − 540 arguments of the immediately surrounding annotation; the text between the
+ − 541 opening and closing parameter annotations is deleted from the buffer but saved
+ − 542 as a string. The surrounding annotation should be listed under the
+ − 543 pseudo-property FUNCTION. Instead of inserting a text-property for this
+ − 544 annotation, the function listed in the VALUE slot is called to make whatever
+ − 545 changes are appropriate. The function's first two arguments are the START and
+ − 546 END locations, and the rest of the arguments are any PARAMETERs found in that
+ − 547 region.
+ − 548
+ − 549 Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
+ − 550 are saved as values of the `unknown' text-property \(which is list-valued).
+ − 551 The TRANSLATIONS list should usually contain an entry of the form
+ − 552 \(unknown \(nil format-annotate-value))
+ − 553 to write these unknown annotations back into the file."
+ − 554 (save-excursion
+ − 555 (save-restriction
+ − 556 (narrow-to-region (point-min) to)
+ − 557 (goto-char from)
+ − 558 (let (next open-ans todo
+ − 559 ;; loc
+ − 560 unknown-ans)
+ − 561 (while (setq next (funcall next-fn))
+ − 562 (let* ((loc (nth 0 next))
+ − 563 (end (nth 1 next))
+ − 564 (name (nth 2 next))
+ − 565 (positive (nth 3 next))
+ − 566 (found nil))
+ − 567
+ − 568 ;; Delete the annotation
+ − 569 (delete-region loc end)
+ − 570 (cond
+ − 571 ;; Positive annotations are stacked, remembering location
+ − 572 (positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans)))
+ − 573 ;; It is a negative annotation:
+ − 574 ;; Close the top annotation & add its text property.
+ − 575 ;; If the file's nesting is messed up, the close might not match
+ − 576 ;; the top thing on the open-annotations stack.
+ − 577 ;; If no matching annotation is open, just ignore the close.
+ − 578 ((not (assoc name open-ans))
+ − 579 (message "Extra closing annotation (%s) in file" name))
+ − 580 ;; If one is open, but not on the top of the stack, close
+ − 581 ;; the things in between as well. Set `found' when the real
+ − 582 ;; one is closed.
+ − 583 (t
+ − 584 (while (not found)
+ − 585 (let* ((top (car open-ans)) ; first on stack: should match.
+ − 586 (top-name (car top)) ; text property name
+ − 587 (top-extents (nth 1 top)) ; property regions
+ − 588 (params (cdr (cdr top))) ; parameters
+ − 589 (aalist translations)
+ − 590 (matched nil))
+ − 591 (if (equal name top-name)
+ − 592 (setq found t)
+ − 593 (message "Improper nesting in file."))
+ − 594 ;; Look through property names in TRANSLATIONS
+ − 595 (while aalist
+ − 596 (let ((prop (car (car aalist)))
+ − 597 (alist (cdr (car aalist))))
+ − 598 ;; And look through values for each property
+ − 599 (while alist
+ − 600 (let ((value (car (car alist)))
+ − 601 (ans (cdr (car alist))))
+ − 602 (if (member top-name ans)
+ − 603 ;; This annotation is listed, but still have to
+ − 604 ;; check if multiple annotations are satisfied
+ − 605 (if (member nil (mapcar (lambda (r)
+ − 606 (assoc r open-ans))
+ − 607 ans))
+ − 608 nil ; multiple ans not satisfied
+ − 609 ;; If there are multiple annotations going
+ − 610 ;; into one text property, split up the other
+ − 611 ;; annotations so they apply individually to
+ − 612 ;; the other regions.
+ − 613 (setcdr (car top-extents) loc)
+ − 614 (let ((to-split ans) this-one extents)
+ − 615 (while to-split
+ − 616 (setq this-one
+ − 617 (assoc (car to-split) open-ans)
+ − 618 extents (nth 1 this-one))
+ − 619 (if (not (eq this-one top))
+ − 620 (setcar (cdr this-one)
+ − 621 (format-subtract-regions
+ − 622 extents top-extents)))
+ − 623 (setq to-split (cdr to-split))))
+ − 624 ;; Set loop variables to nil so loop
+ − 625 ;; will exit.
+ − 626 (setq alist nil aalist nil matched t
+ − 627 ;; pop annotation off stack.
+ − 628 open-ans (cdr open-ans))
+ − 629 (let ((extents top-extents)
+ − 630 (start (car (car top-extents)))
+ − 631 (loc (cdr (car top-extents))))
+ − 632 (while extents
+ − 633 (cond
+ − 634 ;; Check for pseudo-properties
+ − 635 ((eq prop 'PARAMETER)
+ − 636 ;; A parameter of the top open ann:
+ − 637 ;; delete text and use as arg.
+ − 638 (if open-ans
+ − 639 ;; (If nothing open, discard).
+ − 640 (setq open-ans
+ − 641 (cons
+ − 642 (append (car open-ans)
+ − 643 (list
+ − 644 (buffer-substring
+ − 645 start loc)))
+ − 646 (cdr open-ans))))
+ − 647 (delete-region start loc))
+ − 648 ((eq prop 'FUNCTION)
+ − 649 ;; Not a property, but a function.
+ − 650 (let ((rtn
+ − 651 (apply value start loc params)))
+ − 652 (if rtn (setq todo (cons rtn todo)))))
+ − 653 (t
+ − 654 ;; Normal property/value pair
+ − 655 (setq todo
+ − 656 (cons (list start loc prop value)
+ − 657 todo))))
+ − 658 (setq extents (cdr extents)
+ − 659 start (car (car extents))
+ − 660 loc (cdr (car extents))))))))
+ − 661 (setq alist (cdr alist))))
+ − 662 (setq aalist (cdr aalist)))
+ − 663 (unless matched
+ − 664 ;; Didn't find any match for the annotation:
+ − 665 ;; Store as value of text-property `unknown'.
+ − 666 (setcdr (car top-extents) loc)
+ − 667 (let ((extents top-extents)
+ − 668 (start (car (car top-extents)))
+ − 669 (loc (cdr (car top-extents))))
+ − 670 (while extents
+ − 671 (setq open-ans (cdr open-ans)
+ − 672 todo (cons (list start loc 'unknown top-name)
+ − 673 todo)
+ − 674 unknown-ans (cons name unknown-ans)
+ − 675 extents (cdr extents)
+ − 676 start (car (car extents))
+ − 677 loc (cdr (car extents))))))))))))
+ − 678
+ − 679 ;; Once entire file has been scanned, add the properties.
+ − 680 (while todo
+ − 681 (let* ((item (car todo))
+ − 682 (from (nth 0 item))
+ − 683 (to (nth 1 item))
+ − 684 (prop (nth 2 item))
+ − 685 (val (nth 3 item)))
+ − 686
+ − 687 (if (numberp val) ; add to ambient value if numeric
+ − 688 (format-property-increment-region from to prop val 0)
+ − 689 (put-text-property
+ − 690 from to prop
+ − 691 (cond ((get prop 'format-list-valued) ; value gets consed onto
+ − 692 ; list-valued properties
+ − 693 (let ((prev (get-text-property from prop)))
+ − 694 (cons val (if (listp prev) prev (list prev)))))
+ − 695 (t val))))) ; normally, just set to val.
+ − 696 (setq todo (cdr todo)))
+ − 697
+ − 698 (if unknown-ans
+ − 699 (message "Unknown annotations: %s" unknown-ans))))))
+ − 700
+ − 701 (defun format-subtract-regions (minu subtra)
+ − 702 "Remove the regions in SUBTRAHEND from the regions in MINUEND. A region
+ − 703 is a dotted pair (from . to). Both parameters are lists of regions. Each
+ − 704 list must contain nonoverlapping, noncontiguous regions, in descending
+ − 705 order. The result is also nonoverlapping, noncontiguous, and in descending
+ − 706 order. The first element of MINUEND can have a cdr of nil, indicating that
+ − 707 the end of that region is not yet known."
+ − 708 (let* ((minuend (copy-alist minu))
+ − 709 (subtrahend (copy-alist subtra))
+ − 710 (m (car minuend))
+ − 711 (s (car subtrahend))
+ − 712 results)
+ − 713 (while (and minuend subtrahend)
+ − 714 (cond
+ − 715 ;; The minuend starts after the subtrahend ends; keep it.
+ − 716 ((> (car m) (cdr s))
+ − 717 (setq results (cons m results)
+ − 718 minuend (cdr minuend)
+ − 719 m (car minuend)))
+ − 720 ;; The minuend extends beyond the end of the subtrahend. Chop it off.
+ − 721 ((or (null (cdr m)) (> (cdr m) (cdr s)))
+ − 722 (setq results (cons (cons (1+ (cdr s)) (cdr m)) results))
+ − 723 (setcdr m (cdr s)))
+ − 724 ;; The subtrahend starts after the minuend ends; throw it away.
+ − 725 ((< (cdr m) (car s))
+ − 726 (setq subtrahend (cdr subtrahend) s (car subtrahend)))
+ − 727 ;; The subtrahend extends beyond the end of the minuend. Chop it off.
+ − 728 (t ;(<= (cdr m) (cdr s)))
+ − 729 (if (>= (car m) (car s))
+ − 730 (setq minuend (cdr minuend) m (car minuend))
+ − 731 (setcdr m (1- (car s)))
+ − 732 (setq subtrahend (cdr subtrahend) s (car subtrahend))))))
+ − 733 (nconc (nreverse results) minuend)))
+ − 734
+ − 735 ;; This should probably go somewhere other than format.el. Then again,
+ − 736 ;; indent.el has alter-text-property. NOTE: We can also use
+ − 737 ;; next-single-property-change instead of text-property-not-all, but then
+ − 738 ;; we have to see if we passed TO.
+ − 739 (defun format-property-increment-region (from to prop delta default)
+ − 740 "Increment property PROP over the region between FROM and TO by the
+ − 741 amount DELTA (which may be negative). If property PROP is nil anywhere
+ − 742 in the region, it is treated as though it were DEFAULT."
+ − 743 (let ((cur from) val newval next)
+ − 744 (while cur
+ − 745 (setq val (get-text-property cur prop)
+ − 746 newval (+ (or val default) delta)
+ − 747 next (text-property-not-all cur to prop val))
+ − 748 (put-text-property cur (or next to) prop newval)
+ − 749 (setq cur next))))
+ − 750
+ − 751 ;;;
+ − 752 ;;; Encoding
+ − 753 ;;;
+ − 754
+ − 755 (defun format-insert-annotations (list &optional offset)
+ − 756 "Apply list of annotations to buffer as `write-region' would.
+ − 757 Inserts each element of the given LIST of buffer annotations at its
+ − 758 appropriate place. Use second arg OFFSET if the annotations' locations are
+ − 759 not relative to the beginning of the buffer: annotations will be inserted
+ − 760 at their location-OFFSET+1 \(ie, the offset is treated as the character number
+ − 761 of the first character in the buffer)."
+ − 762 (if (not offset)
+ − 763 (setq offset 0)
+ − 764 (setq offset (1- offset)))
+ − 765 (let ((l (reverse list)))
+ − 766 (while l
+ − 767 (goto-char (- (car (car l)) offset))
+ − 768 (insert (cdr (car l)))
+ − 769 (setq l (cdr l)))))
+ − 770
+ − 771 (defun format-annotate-value (old new)
+ − 772 "Return OLD and NEW as a \(close . open) annotation pair.
+ − 773 Useful as a default function for TRANSLATIONS alist when the value of the text
+ − 774 property is the name of the annotation that you want to use, as it is for the
+ − 775 `unknown' text property."
+ − 776 (cons (if old (list old))
+ − 777 (if new (list new))))
+ − 778
+ − 779 (defun format-annotate-region (from to trans format-fn ignore)
+ − 780 "Generate annotations for text properties in the region.
+ − 781 Searches for changes between FROM and TO, and describes them with a list of
+ − 782 annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text
+ − 783 properties not to consider; any text properties that are neither ignored nor
+ − 784 listed in TRANSLATIONS are warned about.
+ − 785 If you actually want to modify the region, give the return value of this
+ − 786 function to `format-insert-annotations'.
+ − 787
+ − 788 Format of the TRANSLATIONS argument:
+ − 789
+ − 790 Each element is a list whose car is a PROPERTY, and the following
+ − 791 elements are VALUES of that property followed by the names of zero or more
+ − 792 ANNOTATIONS. Whenever the property takes on that value, the annotations
+ − 793 \(as formatted by FORMAT-FN) are inserted into the file.
+ − 794 When the property stops having that value, the matching negated annotation
+ − 795 will be inserted \(it may actually be closed earlier and reopened, if
+ − 796 necessary, to keep proper nesting).
+ − 797
+ − 798 If the property's value is a list, then each element of the list is dealt with
+ − 799 separately.
+ − 800
+ − 801 If a VALUE is numeric, then it is assumed that there is a single annotation
+ − 802 and each occurrence of it increments the value of the property by that number.
+ − 803 Thus, given the entry \(left-margin \(4 \"indent\")), if the left margin
+ − 804 changes from 4 to 12, two <indent> annotations will be generated.
+ − 805
+ − 806 If the VALUE is nil, then instead of annotations, a function should be
+ − 807 specified. This function is used as a default: it is called for all
+ − 808 transitions not explicitly listed in the table. The function is called with
+ − 809 two arguments, the OLD and NEW values of the property. It should return
+ − 810 lists of annotations like `format-annotate-location' does.
+ − 811
+ − 812 The same structure can be used in reverse for reading files."
+ − 813 (let ((all-ans nil) ; All annotations - becomes return value
+ − 814 (open-ans nil) ; Annotations not yet closed
+ − 815 (loc nil) ; Current location
+ − 816 (not-found nil)) ; Properties that couldn't be saved
+ − 817 (while (or (null loc)
+ − 818 (and (setq loc (next-property-change loc nil to))
+ − 819 (< loc to)))
+ − 820 (or loc (setq loc from))
+ − 821 (let* ((ans (format-annotate-location loc (= loc from) ignore trans))
+ − 822 (neg-ans (format-reorder (aref ans 0) open-ans))
+ − 823 (pos-ans (aref ans 1))
+ − 824 (ignored (aref ans 2)))
+ − 825 (setq not-found (append ignored not-found)
+ − 826 ignore (append ignored ignore))
+ − 827 ;; First do the negative (closing) annotations
+ − 828 (while neg-ans
+ − 829 ;; Check if it's missing. This can happen (eg, a numeric property
+ − 830 ;; going negative can generate closing annotations before there are
+ − 831 ;; any open). Warn user & ignore.
+ − 832 (if (not (member (car neg-ans) open-ans))
+ − 833 (message "Can't close %s: not open." (car neg-ans))
+ − 834 (while (not (equal (car neg-ans) (car open-ans)))
+ − 835 ;; To close anno. N, need to first close ans 1 to N-1,
+ − 836 ;; remembering to re-open them later.
+ − 837 (setq pos-ans (cons (car open-ans) pos-ans))
+ − 838 (setq all-ans
+ − 839 (cons (cons loc (funcall format-fn (car open-ans) nil))
+ − 840 all-ans))
+ − 841 (setq open-ans (cdr open-ans)))
+ − 842 ;; Now remove the one we're really interested in from open list.
+ − 843 (setq open-ans (cdr open-ans))
+ − 844 ;; And put the closing annotation here.
+ − 845 (setq all-ans
+ − 846 (cons (cons loc (funcall format-fn (car neg-ans) nil))
+ − 847 all-ans)))
+ − 848 (setq neg-ans (cdr neg-ans)))
+ − 849 ;; Now deal with positive (opening) annotations
+ − 850 (let ( ; (p pos-ans)
+ − 851 )
+ − 852 (while pos-ans
+ − 853 (setq open-ans (cons (car pos-ans) open-ans))
+ − 854 (setq all-ans
+ − 855 (cons (cons loc (funcall format-fn (car pos-ans) t))
+ − 856 all-ans))
+ − 857 (setq pos-ans (cdr pos-ans))))))
+ − 858
+ − 859 ;; Close any annotations still open
+ − 860 (while open-ans
+ − 861 (setq all-ans
+ − 862 (cons (cons to (funcall format-fn (car open-ans) nil))
+ − 863 all-ans))
+ − 864 (setq open-ans (cdr open-ans)))
+ − 865 (if not-found
+ − 866 (message "These text properties could not be saved:\n %s"
+ − 867 not-found))
+ − 868 (nreverse all-ans)))
+ − 869
+ − 870 ;;; Internal functions for format-annotate-region.
+ − 871
+ − 872 (defun format-annotate-location (loc all ignore trans)
+ − 873 "Return annotation(s) needed at LOCATION.
+ − 874 This includes any properties that change between LOC-1 and LOC.
+ − 875 If ALL is true, don't look at previous location, but generate annotations for
+ − 876 all non-nil properties.
+ − 877 Third argument IGNORE is a list of text-properties not to consider.
+ − 878
+ − 879 Return value is a vector of 3 elements:
+ − 880 1. List of names of the annotations to close
+ − 881 2. List of the names of annotations to open.
+ − 882 3. List of properties that were ignored or couldn't be annotated."
+ − 883 (let* ((prev-loc (1- loc))
+ − 884 (before-plist (if all nil (text-properties-at prev-loc)))
+ − 885 (after-plist (text-properties-at loc))
+ − 886 p negatives positives prop props not-found)
+ − 887 ;; make list of all property names involved
+ − 888 (setq p before-plist)
+ − 889 (while p
+ − 890 (if (not (memq (car p) props))
+ − 891 (setq props (cons (car p) props)))
+ − 892 (setq p (cdr (cdr p))))
+ − 893 (setq p after-plist)
+ − 894 (while p
+ − 895 (if (not (memq (car p) props))
+ − 896 (setq props (cons (car p) props)))
+ − 897 (setq p (cdr (cdr p))))
+ − 898
+ − 899 (while props
+ − 900 (setq prop (car props)
+ − 901 props (cdr props))
+ − 902 (if (memq prop ignore)
+ − 903 nil ; If it's been ignored before, ignore it now.
+ − 904 (let ((before (if all nil (car (cdr (memq prop before-plist)))))
+ − 905 (after (car (cdr (memq prop after-plist)))))
+ − 906 (if (equal before after)
+ − 907 nil ; no change; ignore
+ − 908 (let ((result (format-annotate-single-property-change
+ − 909 prop before after trans)))
+ − 910 (if (not result)
+ − 911 (setq not-found (cons prop not-found))
+ − 912 (setq negatives (nconc negatives (car result))
+ − 913 positives (nconc positives (cdr result)))))))))
+ − 914 (vector negatives positives not-found)))
+ − 915
+ − 916 (defun format-annotate-single-property-change (prop old new trans)
+ − 917 "Return annotations for PROPERTY changing from OLD to NEW.
+ − 918 These are searched for in the TRANSLATIONS alist.
+ − 919 If NEW does not appear in the list, but there is a default function, then that
+ − 920 function is called.
+ − 921 Annotations to open and to close are returned as a dotted pair."
+ − 922 (let ((prop-alist (cdr (assoc prop trans)))
+ − 923 ;; default
+ − 924 )
+ − 925 (if (not prop-alist)
+ − 926 nil
+ − 927 ;; If either old or new is a list, have to treat both that way.
+ − 928 (if (or (consp old) (consp new))
+ − 929 (let* ((old (if (listp old) old (list old)))
+ − 930 (new (if (listp new) new (list new)))
+ − 931 ;; (tail (format-common-tail old new))
+ − 932 close open)
+ − 933 (while old
+ − 934 (setq close
+ − 935 (append (car (format-annotate-atomic-property-change
+ − 936 prop-alist (car old) nil))
+ − 937 close)
+ − 938 old (cdr old)))
+ − 939 (while new
+ − 940 (setq open
+ − 941 (append (cdr (format-annotate-atomic-property-change
+ − 942 prop-alist nil (car new)))
+ − 943 open)
+ − 944 new (cdr new)))
+ − 945 (format-make-relatively-unique close open))
+ − 946 (format-annotate-atomic-property-change prop-alist old new)))))
+ − 947
+ − 948 (defun format-annotate-atomic-property-change (prop-alist old new)
+ − 949 "Internal function annotate a single property change.
+ − 950 PROP-ALIST is the relevant segment of a TRANSLATIONS list.
+ − 951 OLD and NEW are the values."
+ − 952 (let (num-ann)
+ − 953 ;; If old and new values are numbers,
+ − 954 ;; look for a number in PROP-ALIST.
+ − 955 (if (and (or (null old) (numberp old))
+ − 956 (or (null new) (numberp new)))
+ − 957 (progn
+ − 958 (setq num-ann prop-alist)
+ − 959 (while (and num-ann (not (numberp (car (car num-ann)))))
+ − 960 (setq num-ann (cdr num-ann)))))
+ − 961 (if num-ann
+ − 962 ;; Numerical annotation - use difference
+ − 963 (progn
+ − 964 ;; If property is numeric, nil means 0
+ − 965 (cond ((and (numberp old) (null new))
+ − 966 (setq new 0))
+ − 967 ((and (numberp new) (null old))
+ − 968 (setq old 0)))
+ − 969
+ − 970 (let* ((entry (car num-ann))
+ − 971 (increment (car entry))
+ − 972 (n (ceiling (/ (float (- new old)) (float increment))))
+ − 973 (anno (car (cdr entry))))
+ − 974 (if (> n 0)
+ − 975 (cons nil (make-list n anno))
+ − 976 (cons (make-list (- n) anno) nil))))
+ − 977
+ − 978 ;; Standard annotation
+ − 979 (let ((close (and old (cdr (assoc old prop-alist))))
+ − 980 (open (and new (cdr (assoc new prop-alist)))))
+ − 981 (if (or close open)
+ − 982 (format-make-relatively-unique close open)
+ − 983 ;; Call "Default" function, if any
+ − 984 (let ((default (assq nil prop-alist)))
+ − 985 (if default
+ − 986 (funcall (car (cdr default)) old new))))))))
+ − 987
+ − 988 ;;; format.el ends here