Suggestion for new emacs functionality

[Daniel Polani <d.polani@herts.ac.uk>]

Hello all,

I would like to submit two new functionalities for either inclusion in
the standard emacs distribution or as extra package (which, however, I
would not believe would make sense, as they are quite small).

I found both functions extremely useful and use them often. I am happy
to transfer the copyright to the FSF if a standard inclusion into the
emacs distribution is planned. Alternatively I would release them
under the GPL.

I posted shell-current-directory many years ago into the emacs.sources
newsgroup and did never get a reaction until several years later, when
somebody actually gave feedback and mentioned that he was using it all
the time. So, I believe, it is a useful command.

Please let me know if there is any open question or request. Please
note that I have no access to the emacs newsgroups at my present
location, so if you wish to contact me, please send me a direct mail.

-- 
Daniel Polani

| Dept of Computer Science                | Tel. +44/1707/28 4380 |
| University of Hertfordshire             | Fax: +44/1707/28 4303 |
| Hatfield, Herts AL10 9AB                |                       |
| United Kingdom                          |                       |
-------------------------------------------------------------------
| Web:                http://homepages.feis.herts.ac.uk/~comqdp1/ |



;;; write-file-from-buffer

;;; write-file-from-buffer, is useful if you have
;;; loaded a file from some directory, say 'A' into an emacs buffer. If
;;; your current buffer has default directory 'B' (e.g. it can be an
;;; dired-buffer), then you can use M-x write-file-from-buffer to write an
;;; existing buffer content into the present directory. This saves you
;;; looking for the original file and/or directory.

(defun write-file-from-buffer (buf)

  "Write BUFFER to file with same name of visited file to current directory.
Current directory is given by current buffer."

  (interactive "b")
  (save-excursion
    (let ((dir default-directory))
      (set-buffer buf)
      (write-file dir t))))


;;; shell-current-directory

;;; shell-current-directory works like the command called via M-x shell
;;; with the difference that a shell is started using the current default
;;; directory and a new shell is started in each new directory.

(defun directory-shell-buffer-name ()

  "The name of a shell buffer pertaining to DIR."

  (concat "*" 
	  (file-name-nondirectory 
	   (directory-file-name (expand-file-name default-directory))) 
	  "-shell*"))


(defun directory-shell-buffer ()

  "Return a buffer with the current default directory shell process."

  (let ((buflist (buffer-list))
	found
	buffer
	buffer-directory
	bufproc
	retval)
    (while (and (not found) buflist)
      (setq buffer (pop buflist))
      (setq buffer-directory
	    (save-excursion 
	      (set-buffer buffer)
	      default-directory))

      (setq bufproc (get-buffer-process buffer))

      (if bufproc
	  (if (and (string-match "^shell\\(<[0-9]*>\\)?$" 
				 (process-name bufproc))
		   (string= default-directory buffer-directory))
	      (setq found t))))

    (if found
	buffer
      nil)))


      
(defun shell-current-directory ()

  "Create a shell pertaining to the current directory."

  (interactive)
  (let ((current-shell-buffer (directory-shell-buffer))
	original-shell-buffer)

    (if current-shell-buffer
	(pop-to-buffer current-shell-buffer)

      ;; no current process buffer is active
      ;; if *shell* is already used, store it
      (if (buffer-live-p "*shell*")
	(save-excursion
	  (set-buffer "*shell*")
	  (setq original-shell-buffer (rename-uniquely))))
      
      ;; and create a new shell process with the current directory

      (shell)
      (rename-buffer (directory-shell-buffer-name) t) ; unique
    
      (if original-shell-buffer		; there has been a standard
					; *shell* buffer before,
					; restore it

	  (save-excursion
	    (set-buffer original-shell-buffer)
	    (rename-buffer "*shell*"))))))