bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Suggestion for new emacs functionality


From: Daniel Polani
Subject: Suggestion for new emacs functionality
Date: Fri, 8 Nov 2002 20:34:13 GMT

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





reply via email to

[Prev in Thread] Current Thread [Next in Thread]