Mercurial > hg > xemacs-beta
diff lisp/viper/viper-ex.el @ 82:6a378aca36af r20-0b91
Import from CVS: tag r20-0b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:07:36 +0200 |
parents | 1ce6082ce73f |
children | cf808b4c4290 |
line wrap: on
line diff
--- a/lisp/viper/viper-ex.el Mon Aug 13 09:06:45 2007 +0200 +++ b/lisp/viper/viper-ex.el Mon Aug 13 09:07:36 2007 +0200 @@ -1,6 +1,6 @@ ;;; viper-ex.el --- functions implementing the Ex commands for Viper -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -36,15 +36,16 @@ (defvar vip-case-fold-search) (eval-when-compile - (let ((load-path (cons "." load-path))) + (let ((load-path (cons (expand-file-name ".") load-path))) (or (featurep 'viper-util) (load "viper-util.el" nil nil 'nosuffix)) (or (featurep 'viper-keym) (load "viper-keym.el" nil nil 'nosuffix)) + (or (featurep 'viper) + (load "viper.el" nil nil 'nosuffix)) )) ;; end pacifier - (require 'viper-util) @@ -657,7 +658,8 @@ ;; Get an ex-address as a marker and set ex-flag if a flag is found (defun vip-get-ex-address () - (let ((address (point-marker)) (cont t)) + (let ((address (point-marker)) + (cont t)) (setq ex-token "") (setq ex-flag nil) (while cont @@ -1872,7 +1874,11 @@ (defun ex-write (q-flag) (vip-default-ex-addresses t) (vip-get-ex-file) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) + (let ((end (car ex-addresses)) + (beg (car (cdr ex-addresses))) + (orig-buf (current-buffer)) + (orig-buf-file-name (buffer-file-name)) + (buff-changed-p (buffer-modified-p)) temp-buf writing-same-file region file-exists writing-whole-file) (if (> beg end) (error vip-FirstAddrExceedsSecond)) @@ -1895,8 +1901,9 @@ buffer-file-name (not (file-directory-p buffer-file-name))) (setq ex-file - (concat ex-file (file-name-nondirectory buffer-file-name)))) - + (concat (file-name-as-directory ex-file) + (file-name-nondirectory buffer-file-name)))) + (setq file-exists (file-exists-p ex-file) writing-same-file (string= ex-file (buffer-file-name))) @@ -1904,34 +1911,52 @@ (if (not (buffer-modified-p)) (message "(No changes need to be saved)") (save-buffer) - (ex-write-info file-exists ex-file beg end)) - ;; writing some other file or portion of the currents - ;; file---create temp buffer for it - ;; disable undo in that buffer, for efficiency - (buffer-disable-undo (setq temp-buf (create-file-buffer ex-file))) - (unwind-protect - (save-excursion - (if (and file-exists - (not writing-same-file) - (not (yes-or-no-p - (format "File %s exists. Overwrite? " ex-file)))) - (error "Quit") - (vip-enlarge-region beg end) - (setq region (buffer-substring (point) (mark t))) - (set-buffer temp-buf) - (set-visited-file-name ex-file) - (erase-buffer) - (if (and file-exists ex-append) - (insert-file-contents ex-file)) - (goto-char (point-max)) - (insert region) - (save-buffer) - (ex-write-info file-exists ex-file (point-min) (point-max)) - )) - (set-buffer temp-buf) - (set-buffer-modified-p nil) - (kill-buffer temp-buf) - )) + (save-restriction + (widen) + (ex-write-info file-exists ex-file (point-min) (point-max)) + )) + ;; writing some other file or portion of the current file + (cond ((and file-exists + (not writing-same-file) + (not (yes-or-no-p + (format "File %s exists. Overwrite? " ex-file)))) + (error "Quit")) + ((and writing-whole-file (not ex-append)) + (unwind-protect + (progn + (set-visited-file-name ex-file) + (set-buffer-modified-p t) + (save-buffer)) + ;; restore the buffer file name + (set-visited-file-name orig-buf-file-name) + (set-buffer-modified-p buff-changed-p)) + (save-restriction + (widen) + (ex-write-info + file-exists ex-file (point-min) (point-max)))) + (t ; writing a region + (unwind-protect + (save-excursion + (vip-enlarge-region beg end) + (setq region (buffer-substring (point) (mark t))) + ;; create temp buffer for the region + (setq temp-buf (get-buffer-create " *ex-write*")) + (set-buffer temp-buf) + (set-visited-file-name ex-file 'noquerry) + (erase-buffer) + (if (and file-exists ex-append) + (insert-file-contents ex-file)) + (goto-char (point-max)) + (insert region) + (save-buffer) + (ex-write-info + file-exists ex-file (point-min) (point-max)) + )) + (set-buffer temp-buf) + (set-buffer-modified-p nil) + (kill-buffer temp-buf)) + )) + (set-buffer orig-buf) ;; this prevents the loss of data if writing part of the buffer (if (and (buffer-file-name) writing-same-file) (set-visited-file-modtime))