Re: Missing `with' macro?

["Stuart D. Herring" <herring@lanl.gov>]

[-- Attachment #1: Type: text/plain, Size: 896 bytes --]

> To develop a general macro for this would be useful.  It is not a
> trivial thing.  Please start working on it if you want.  The case of
> just examining a file without altering it, since that is more common,
> and easier.  I suspect that we may need two totally different macros
> for the read-only case and the case of altering the file.

I've implemented a first draft of this, complete with file-writing
capacity in the same macro: see the attached file and please comment.  (In
particular, is there a clean way to silence `save-buffer' or the
equivalent?)  I still don't quite have papers, but I am led to believe
that it will happen Real Soon Now; since this isn't going into this
release AFAIK, I hope that's not a problem.

Davis

-- 
This product is sold by volume, not by mass.  If it appears too dense or
too sparse, it is because mass-energy conversion has occurred during
shipping.

[-- Attachment #2: with-file.el --]
[-- Type: application/octet-stream, Size: 5120 bytes --]

(put 'hide-message 'lisp-indent-function 0)
(defmacro hide-message (&rest body)
	"Execute BODY, then restore the previous contents of the echo area.
Messages produced by BODY are not logged."
	(let ((pm-sym (make-symbol "prev-msg")))
		`(let ((,pm-sym (current-message)) message-log-max)
			 ,@body
			 (message ,pm-sym))))

(put 'with-file 'lisp-indent-function 4)
(defmacro with-file (file visit reuse write &rest body)
	"Execute the forms in BODY in a buffer with FILE's text loaded.
Point begins at the beginning of the buffer, which is not narrowed.
The value returned is the value of the last form in BODY.

VISIT t means actually visit the file, loading its appropriate major mode and
local variables and such.  VISIT nil means do none of these things; BODY will
be executed in a buffer with the contents of FILE but that is visiting no
file.  Any other value for VISIT works like nil except that the file is read
literally (see `insert-file-contents-literally').

REUSE non-nil means to use an existing buffer if it is visiting FILE.  (The
value of `find-file-existing-other-name' affects this determination.)  The
buffer will only be re-used if its literal status (see `find-file-literally')
matches the literal status requested by VISIT.  Note that reusing a buffer may
mean that the text on which BODY operates differs from the actual contents of
FILE.

WRITE non-nil means to modify the file; if the BODY finishes normally, then
the buffer is saved if the file was visited or written otherwise.  If WRITE is
neither t nor nil, saving messages are suppressed.  The buffer will be
read-only when BODY is executed iff WRITE is nil.

If a buffer is created in the execution of this macro, it is killed when it
finishes (even in the case of abnormal exit), regardless of any unsaved
changes made."
	(let ((file-sym (make-symbol "file"))
				(visit-sym (make-symbol "visit"))
				(raw-sym (make-symbol "raw"))
				(reuse-sym (make-symbol "reuse"))
				(write-sym (make-symbol "write"))
				(quiet-sym (make-symbol "quiet"))
        (extant-sym (make-symbol "extant"))
        (extant-file-sym (make-symbol "extant-file"))
        (buf-sym (make-symbol "buf"))
				(reused-sym (make-symbol "reused"))
				(bro-sym (make-symbol "buf-readonly")))
		`(let* ((,file-sym ,file)
						(,visit-sym ,visit)
						(,raw-sym (and ,visit-sym (not (eq ,visit-sym t))))
						(,reuse-sym ,reuse)
						(,write-sym ,write)
						(,quiet-sym (and ,write-sym (not (eq ,write-sym t))))
						(,extant-sym (if find-file-existing-other-name
														 (find-buffer-visiting ,file-sym)
													 (get-file-buffer ,file-sym)))
						(,extant-file-sym (and ,extant-sym (buffer-file-name ,extant-sym)))
						(,buf-sym
						 (or (and ,reuse-sym ,extant-sym
											(eq (not (with-current-buffer ,extant-sym
																 find-file-literally))
													(not ,raw-sym))
											,extant-sym)
								 (if (eq ,visit-sym t)
										 (progn
											 ;; We need to pretend that any other visiting buffer
											 ;; doesn't actually exist.
											 (if ,extant-sym
													 (with-current-buffer ,extant-sym
														 (setq buffer-file-name nil)))
											 (find-file-noselect ,file-sym t))
									 (with-current-buffer (generate-new-buffer "*with-file*")
										 (if (eq ,visit-sym nil)
												 (insert-file-contents ,file-sym)
											 (insert-file-contents-literally ,file-sym))
										 (current-buffer)))))
						(,reused-sym (eq ,buf-sym ,extant-sym))
						(,bro-sym (with-current-buffer ,buf-sym buffer-read-only)))
			 (with-current-buffer ,buf-sym
				 (unwind-protect
						 (save-excursion
							 (save-restriction
								 (widen)
								 (goto-char (point-min))
								 ;; We don't just let-bind buffer-read-only because that
								 ;; interacts poorly with switching buffers.
								 (setq buffer-read-only (not ,write-sym))
								 (prog1 (save-current-buffer ,@body)
									 (and (buffer-live-p ,buf-sym) ,write-sym
												(if (or ,reused-sym (eq ,visit-sym t))
														(if ,quiet-sym (hide-message (save-buffer))
															(save-buffer))
													(let ((coding-system-for-write
																 (if ,raw-sym 'no-conversion
																	 coding-system-for-write)))
														(widen)
														(write-region (point-min) (point-max) ,file-sym nil
																					(if ,quiet-sym 'lambda))))))))
					 (when (buffer-live-p ,buf-sym)
						 (setq buffer-read-only ,bro-sym)
						 (unless ,reused-sym
							 (set-buffer-modified-p nil)
							 (kill-buffer nil)))
					 (when (buffer-live-p ,extant-sym)
						 (with-current-buffer ,extant-sym
							 (setq buffer-file-name ,extant-file-sym))))))))

(defun with-file-test (file arg)
	"Test `with-file' by inserting at the beginning of FILE.
Use 'silent with prefix ARG.  Use 'raw with two C-u's."
	(interactive "f\nP")
	(with-file file (if (equal arg '(16)) 'raw t) nil (if arg 'silent t)
		(insert "foo\n")
		;; Print some multibyte stuff to demonstrate the action of literal mode.
		(message "%S" (and (re-search-forward "[^\0-\d]" nil t)
											 (match-string 0)))))

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel