Mercurial > emacs
comparison lisp/format.el @ 89909:68c22ea6027c
Sync to HEAD
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Fri, 16 Apr 2004 12:51:06 +0000 |
parents | 2f877ed80fa6 |
children | 4c90ffeb71c5 |
comparison
equal
deleted
inserted
replaced
89908:ee1402f7b568 | 89909:68c22ea6027c |
---|---|
1 ;;; format.el --- read and save files in multiple formats | 1 ;;; format.el --- read and save files in multiple formats |
2 | 2 |
3 ;; Copyright (c) 1994, 1995, 1997, 1999 Free Software Foundation | 3 ;; Copyright (c) 1994, 1995, 1997, 1999, 2004 Free Software Foundation |
4 | 4 |
5 ;; Author: Boris Goldowsky <boris@gnu.org> | 5 ;; Author: Boris Goldowsky <boris@gnu.org> |
6 | 6 |
7 ;; This file is part of GNU Emacs. | 7 ;; This file is part of GNU Emacs. |
8 | 8 |
276 ;; Deal with given format(s) | 276 ;; Deal with given format(s) |
277 (or (listp format) (setq format (list format))) | 277 (or (listp format) (setq format (list format))) |
278 (let ((do format) f) | 278 (let ((do format) f) |
279 (while do | 279 (while do |
280 (or (setq f (assq (car do) format-alist)) | 280 (or (setq f (assq (car do) format-alist)) |
281 (error "Unknown format" (car do))) | 281 (error "Unknown format %s" (car do))) |
282 ;; Decode: | 282 ;; Decode: |
283 (if (nth 3 f) | 283 (if (nth 3 f) |
284 (setq end (format-decode-run-method (nth 3 f) begin end))) | 284 (setq end (format-decode-run-method (nth 3 f) begin end))) |
285 ;; Call visit function if required | 285 ;; Call visit function if required |
286 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) | 286 (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) |
355 (current-buffer))) | 355 (current-buffer))) |
356 (format-insert-annotations | 356 (format-insert-annotations |
357 (funcall to-fn beg end (current-buffer))))) | 357 (funcall to-fn beg end (current-buffer))))) |
358 (setq format (cdr format))))))) | 358 (setq format (cdr format))))))) |
359 | 359 |
360 (defun format-write-file (filename format) | 360 (defun format-write-file (filename format &optional confirm) |
361 "Write current buffer into file FILENAME using some FORMAT. | 361 "Write current buffer into file FILENAME using some FORMAT. |
362 Makes buffer visit that file and sets the format as the default for future | 362 Make buffer visit that file and set the format as the default for future |
363 saves. If the buffer is already visiting a file, you can specify a directory | 363 saves. If the buffer is already visiting a file, you can specify a directory |
364 name as FILENAME, to write a file of the same old name in that directory." | 364 name as FILENAME, to write a file of the same old name in that directory. |
365 | |
366 If optional third arg CONFIRM is non-nil, this function asks for | |
367 confirmation before overwriting an existing file. Interactively, | |
368 confirmation is required unless you supply a prefix argument." | |
365 (interactive | 369 (interactive |
366 ;; Same interactive spec as write-file, plus format question. | 370 ;; Same interactive spec as write-file, plus format question. |
367 (let* ((file (if buffer-file-name | 371 (let* ((file (if buffer-file-name |
368 (read-file-name "Write file: " | 372 (read-file-name "Write file: " |
369 nil nil nil nil) | 373 nil nil nil nil) |
371 (cdr (assq 'default-directory | 375 (cdr (assq 'default-directory |
372 (buffer-local-variables))) | 376 (buffer-local-variables))) |
373 nil nil (buffer-name)))) | 377 nil nil (buffer-name)))) |
374 (fmt (format-read (format "Write file `%s' in format: " | 378 (fmt (format-read (format "Write file `%s' in format: " |
375 (file-name-nondirectory file))))) | 379 (file-name-nondirectory file))))) |
376 (list file fmt))) | 380 (list file fmt (not current-prefix-arg)))) |
377 (let ((old-formats buffer-file-format) | 381 (let ((old-formats buffer-file-format) |
378 preserve-formats) | 382 preserve-formats) |
379 (dolist (fmt old-formats) | 383 (dolist (fmt old-formats) |
380 (let ((aelt (assq fmt format-alist))) | 384 (let ((aelt (assq fmt format-alist))) |
381 (if (nth 7 aelt) | 385 (if (nth 7 aelt) |
382 (push fmt preserve-formats)))) | 386 (push fmt preserve-formats)))) |
383 (setq buffer-file-format format) | 387 (setq buffer-file-format format) |
384 (dolist (fmt preserve-formats) | 388 (dolist (fmt preserve-formats) |
385 (unless (memq fmt buffer-file-format) | 389 (unless (memq fmt buffer-file-format) |
386 (setq buffer-file-format (append buffer-file-format (list fmt)))))) | 390 (setq buffer-file-format (append buffer-file-format (list fmt)))))) |
387 (write-file filename)) | 391 (write-file filename confirm)) |
388 | 392 |
389 (defun format-find-file (filename format) | 393 (defun format-find-file (filename format) |
390 "Find the file FILENAME using data format FORMAT. | 394 "Find the file FILENAME using data format FORMAT. |
391 If FORMAT is nil then do not do any format conversion." | 395 If FORMAT is nil then do not do any format conversion." |
392 (interactive | 396 (interactive |
405 If FORMAT is nil then do not do any format conversion. | 409 If FORMAT is nil then do not do any format conversion. |
406 The optional third and fourth arguments BEG and END specify | 410 The optional third and fourth arguments BEG and END specify |
407 the part of the file to read. | 411 the part of the file to read. |
408 | 412 |
409 The return value is like the value of `insert-file-contents': | 413 The return value is like the value of `insert-file-contents': |
410 a list (ABSOLUTE-FILE-NAME . SIZE)." | 414 a list (ABSOLUTE-FILE-NAME SIZE)." |
411 (interactive | 415 (interactive |
412 ;; Same interactive spec as write-file, plus format question. | 416 ;; Same interactive spec as write-file, plus format question. |
413 (let* ((file (read-file-name "Find file: ")) | 417 (let* ((file (read-file-name "Find file: ")) |
414 (fmt (format-read (format "Read file `%s' in format: " | 418 (fmt (format-read (format "Read file `%s' in format: " |
415 (file-name-nondirectory file))))) | 419 (file-name-nondirectory file))))) |
418 (let ((format-alist nil)) | 422 (let ((format-alist nil)) |
419 (setq value (insert-file-contents filename nil beg end)) | 423 (setq value (insert-file-contents filename nil beg end)) |
420 (setq size (nth 1 value))) | 424 (setq size (nth 1 value))) |
421 (if format | 425 (if format |
422 (setq size (format-decode format size) | 426 (setq size (format-decode format size) |
423 value (cons (car value) size))) | 427 value (list (car value) size))) |
424 value)) | 428 value)) |
425 | 429 |
426 (defun format-read (&optional prompt) | 430 (defun format-read (&optional prompt) |
427 "Read and return the name of a format. | 431 "Read and return the name of a format. |
428 Return value is a list, like `buffer-file-format'; it may be nil. | 432 Return value is a list, like `buffer-file-format'; it may be nil. |
1038 (if default | 1042 (if default |
1039 (funcall (car (cdr default)) old new)))))))) | 1043 (funcall (car (cdr default)) old new)))))))) |
1040 | 1044 |
1041 (provide 'format) | 1045 (provide 'format) |
1042 | 1046 |
1047 ;;; arch-tag: c387e9c7-a93d-47bf-89bc-8ca67e96755a | |
1043 ;;; format.el ends here | 1048 ;;; format.el ends here |