Mercurial > hg > xemacs-beta

comparison lisp/code-files.el @ 4266:c5a2b80bc4fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-11-14 18:51:20 by aidan] Import make-temp-name (the functionality of mkstemp(3)) from GNU.
author aidan
date Wed, 14 Nov 2007 18:51:31 +0000
parents 579f03038f61
children fdf43260ae29
comparison
equal deleted inserted replaced
4265:dc697b1b786f 4266:c5a2b80bc4fa
512 The functions on this hook are called with arguments START, END, 512 The functions on this hook are called with arguments START, END,
513 FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the 513 FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the
514 corresponding arguments in the call to `write-region'.") 514 corresponding arguments in the call to `write-region'.")
515 515
516 (defun write-region (start end filename 516 (defun write-region (start end filename
517 &optional append visit lockname coding-system) 517 &optional append visit lockname
518 coding-system-or-mustbenew)
518 "Write current region into specified file. 519 "Write current region into specified file.
519 By default the file's existing contents are replaced by the specified region. 520 By default the file's existing contents are replaced by the specified region.
520 Called interactively, prompts for a file name. With a prefix arg, prompts 521 Called interactively, prompts for a file name. With a prefix arg, prompts
521 for a coding system as well. 522 for a coding system as well.
522 523
534 that means do not print the \"Wrote file\" message. 535 that means do not print the \"Wrote file\" message.
535 The optional sixth arg LOCKNAME, if non-nil, specifies the name to 536 The optional sixth arg LOCKNAME, if non-nil, specifies the name to
536 use for locking and unlocking, overriding FILENAME and VISIT. 537 use for locking and unlocking, overriding FILENAME and VISIT.
537 Kludgy feature: if START is a string, then that string is written 538 Kludgy feature: if START is a string, then that string is written
538 to the file, instead of any buffer contents, and END is ignored. 539 to the file, instead of any buffer contents, and END is ignored.
539 Optional seventh argument CODING-SYSTEM specifies the coding system 540
540 used to encode the text when it is written out, and defaults to 541 Optional seventh argument CODING-SYSTEM-OR-MUSTBENEW has a rather kludgy
541 the value of `buffer-file-coding-system' in the current buffer. 542 interpretation. If it is a coding system it describes the coding system
543 used to encode the text when it is written out, defaulting to to the value
544 of `buffer-file-coding-system' in the current buffer.
545
546 If CODING-SYSTEM-OR-MUSTBENEW is non-nil and not a coding system, it means
547 that a check for an existing file with the same name should be made; with
548 a value of 'excl XEmacs will error if the file already exists and never
549 overwrite it. If it is some other non-nil non-coding-system value, the
550 user will be asked for confirmation if the file already exists, and the
551 file will be overwritten if confirmation is given.
552
542 See also `write-region-pre-hook' and `write-region-post-hook'." 553 See also `write-region-pre-hook' and `write-region-post-hook'."
543 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") 554 (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
544 (setq coding-system 555 (let (mustbenew coding-system func hook-result)
545 (or coding-system-for-write 556 (setq hook-result
546 (run-hook-with-args-until-success 557 (or coding-system-for-write
547 'write-region-pre-hook 558 (run-hook-with-args-until-success
548 start end filename append visit lockname coding-system) 559 'write-region-pre-hook
549 coding-system 560 start end filename append visit lockname
550 buffer-file-coding-system 561 coding-system-or-mustbenew)
551 (find-file-coding-system-for-write-from-filename filename) 562 coding-system
552 )) 563 buffer-file-coding-system
553 (if (consp coding-system) 564 (find-file-coding-system-for-write-from-filename filename)))
554 ;; One of the `write-region-pre-hook' functions wrote the file 565 (if (consp hook-result)
555 coding-system 566 ;; One of the `write-region-pre-hook' functions wrote the file.
556 (let ((func 567 hook-result
557 (coding-system-property coding-system 'pre-write-conversion))) 568 ;; The hooks didn't do the work; do it ourselves.
569 (setq mustbenew (unless (coding-system-p coding-system-or-mustbenew)
570 coding-system-or-mustbenew)
571 coding-system (cond ((coding-system-p hook-result) hook-result)
572 ((null mustbenew) coding-system-or-mustbenew))
573 func (coding-system-property coding-system 'pre-write-conversion))
558 (if func 574 (if func
559 (let ((curbuf (current-buffer)) 575 (let ((curbuf (current-buffer))
560 (tempbuf (generate-new-buffer " *temp-write-buffer*")) 576 (tempbuf (generate-new-buffer " *temp-write-buffer*"))
561 (modif (buffer-modified-p))) 577 (modif (buffer-modified-p)))
562 (unwind-protect 578 (unwind-protect
567 (funcall func (point-min) (point-max)) 583 (funcall func (point-min) (point-max))
568 (write-region-internal (point-min) (point-max) filename 584 (write-region-internal (point-min) (point-max) filename
569 append 585 append
570 (if (eq visit t) nil visit) 586 (if (eq visit t) nil visit)
571 lockname 587 lockname
572 coding-system)) 588 coding-system
589 mustbenew))
573 ;; leaving a buffer associated with file will cause problems 590 ;; leaving a buffer associated with file will cause problems
574 ;; when next visiting. 591 ;; when next visiting.
575 (kill-buffer tempbuf) 592 (kill-buffer tempbuf)
576 (if (or visit (null modif)) 593 (if (or visit (null modif))
577 (progn 594 (progn
578 (set-buffer-auto-saved) 595 (set-buffer-auto-saved)
579 (set-buffer-modified-p nil) 596 (set-buffer-modified-p nil)
580 (if (buffer-file-name) (set-visited-file-modtime)))))) 597 (if (buffer-file-name) (set-visited-file-modtime))))))
581 (write-region-internal start end filename append visit lockname 598 (write-region-internal start end filename append visit lockname
582 coding-system))) 599 coding-system mustbenew)))
583 (run-hook-with-args 'write-region-post-hook 600 (run-hook-with-args 'write-region-post-hook
584 start end filename append visit lockname 601 start end filename append visit lockname
585 coding-system))) 602 coding-system)))
586 603
587 ;;; code-files.el ends here 604 ;;; code-files.el ends here