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))