Mercurial > hg > xemacs-beta
diff lisp/efs/default-dir.el @ 22:8fc7fe29b841 r19-15b94
Import from CVS: tag r19-15b94
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:29 +0200 |
parents | |
children | 4103f0995bd7 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/efs/default-dir.el Mon Aug 13 08:50:29 2007 +0200 @@ -0,0 +1,346 @@ +;; -*-Emacs-Lisp-*- +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; File: default-dir.el +;; RCS: +;; Version: $Revision: 1.5 $ +;; Description: Defines the function default-directory, for fancy handling +;; of the initial contents in the minibuffer when reading +;; file names. +;; Authors: Sebastian Kremer <sk@thp.uni-koeln.de> +;; Sandy Rutherford <sandy@ibm550.sissa.it> +;; Created: Sun Jul 18 11:38:06 1993 by sandy on ibm550 +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +(provide 'default-dir) +(require 'efs-ovwrt) + +(defconst default-dir-emacs-variant + (cond ((string-match "XEmacs" emacs-version) 'xemacs) + ((>= (string-to-int (substring emacs-version 0 2)) 19) 'fsf-19) + (t 'fsf-18))) + +;;;###autoload +(defvar default-directory-function nil + "A function to call to compute the default-directory for the current buffer. +If this is nil, the function default-directory will return the value of the +variable default-directory. +Buffer local.") +(make-variable-buffer-local 'default-directory-function) + +;; As a bonus we give shell-command history if possible. +(defvar shell-command-history nil + "History list of previous shell commands.") + +(defun default-directory () + " Returns the default-directory for the current buffer. +Will use the variable default-directory-function if it non-nil." + (if default-directory-function + (funcall default-directory-function) + (if (eq default-dir-emacs-version 'xemacs) + (abbreviate-file-name default-directory t) + (abbreviate-file-name default-directory)))) + +;;; Overloads + +(if (or (featurep 'mule) + (boundp 'MULE)) + (progn + + (defun default-dir-find-file (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file: " (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file file coding-system)) + + (defun default-dir-find-file-other-window (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other window: " (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-other-window file coding-system)) + + (defun default-dir-find-file-read-only (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only: " (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only file coding-system)) + + (if (fboundp 'find-file-read-only-other-window) + (progn + (defun default-dir-find-file-read-only-other-window + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name + "Find file read-only in other window: " + (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only-other-window file + coding-system)))) + + (if (fboundp 'find-file-other-frame) + (progn + (defun default-dir-find-file-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other frame: " + (default-directory))) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-other-frame file + coding-system)))) + + (if (fboundp 'find-file-read-only-other-frame) + (progn + (defun default-dir-find-file-read-only-other-frame + (file &optional coding-system) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only in other frame: " + (default-directory) nil t)) + (and current-prefix-arg + (read-coding-system "Coding-system: ")))) + (default-dir-real-find-file-read-only-other-frame file + coding-system))))) + + (defun default-dir-find-file (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file: " (default-directory))))) + (default-dir-real-find-file file)) + + (defun default-dir-find-file-other-window (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other window: " (default-directory))))) + (default-dir-real-find-file-other-window file)) + + (defun default-dir-find-file-read-only (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only: " (default-directory) nil t)))) + (default-dir-real-find-file-read-only file)) + + (if (fboundp 'find-file-read-only-other-window) + (progn + (defun default-dir-find-file-read-only-other-window (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name + "Find file read-only in other window: " + (default-directory) nil t)))) + (default-dir-real-find-file-read-only-other-window file)))) + + (if (fboundp 'find-file-other-frame) + (progn + (defun default-dir-find-file-other-frame (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file in other frame: " + (default-directory))))) + (default-dir-real-find-file-other-frame file)))) + + (if (fboundp 'find-file-read-only-other-frame) + (progn + (defun default-dir-find-file-read-only-other-frame (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Find file read-only in other frame: " + (default-directory) nil t)))) + (default-dir-real-find-file-read-only-other-frame file))))) + +(efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file) +(efs-overwrite-fn "default-dir" 'find-file-other-window + 'default-dir-find-file-other-window) +(if (fboundp 'find-file-other-frame) + (efs-overwrite-fn "default-dir" 'find-file-other-frame + 'default-dir-find-file-other-frame)) +(efs-overwrite-fn "default-dir" 'find-file-read-only + 'default-dir-find-file-read-only) +(if (fboundp 'find-file-read-only-other-window) + (efs-overwrite-fn "default-dir" 'find-file-read-only-other-window + 'default-dir-find-file-read-only-other-window)) +(if (fboundp 'find-file-read-only-other-frame) + (efs-overwrite-fn "default-dir" 'find-file-read-only-other-frame + 'default-dir-find-file-read-only-other-frame)) + + +(defun default-dir-load-file (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Load file: " (default-directory) nil t)))) + (default-dir-real-load-file file)) + +(efs-overwrite-fn "default-dir" 'load-file 'default-dir-load-file) + +(require 'view) + +(defun default-dir-view-file (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "View file: " (default-directory) nil t)))) + (default-dir-real-view-file file)) + +(efs-overwrite-fn "default-dir" 'view-file 'default-dir-view-file) + +(if (fboundp 'view-file-other-window) + (progn + (defun default-dir-view-file-other-window (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "View file in other window: " + (default-directory) nil t)))) + (default-dir-real-view-file-other-window file)) + (efs-overwrite-fn "default-dir" 'view-file-other-window + 'default-dir-view-file-other-window))) + +(if (fboundp 'view-file-other-frame) + (progn + (defun default-dir-view-file-other-frame (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "View file in other frame: " + (default-directory) nil t)))) + (default-dir-real-view-file-other-frame file)) + (efs-overwrite-fn "default-dir" 'view-file-other-frame + 'default-dir-view-file-other-frame))) + + +(defun default-dir-shell-command (command &optional insert) + "Documented as original" + (interactive + (list + (let ((prompt (format "Shell command in %s: " (default-directory)))) + (cond + ((memq default-dir-emacs-variant '(fsf-19 xemacs)) + (read-from-minibuffer prompt nil nil nil + 'shell-command-history)) + ((featurep 'gmhist) + (let ((minibuffer-history-symbol 'shell-command-history)) + (read-string prompt))) + (t (read-string prompt)))) + current-prefix-arg)) + (let ((default-directory (expand-file-name (default-directory)))) + (default-dir-real-shell-command command insert))) + +(efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command) + +;; Is advice about? +(if (featurep 'advice) + (defadvice cd (before default-dir-cd activate compile) + (interactive + (list + (expand-file-name + (read-file-name "Change default directory: " (default-directory)))))) + + (defun default-dir-cd (dir) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Change default directory: " (default-directory))))) + (default-dir-real-cd dir)) + + (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd)) + +(defun default-dir-set-visited-file-name (filename) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Set visited file name: " (default-directory))))) + (default-dir-real-set-visited-file-name filename)) + +(efs-overwrite-fn "default-dir" 'set-visited-file-name + 'default-dir-set-visited-file-name) + +(defun default-dir-insert-file (filename &rest args) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Insert file: " (default-directory) nil t)))) + (apply 'default-dir-real-insert-file filename args)) + +(efs-overwrite-fn "default-dir" 'insert-file 'default-dir-insert-file) + +(defun default-dir-append-to-file (start end filename &rest args) + "Documented as original" + (interactive + (progn + (or (mark) (error "The mark is not set now")) + (list + (min (mark) (point)) + (max (mark) (point)) + (expand-file-name + (read-file-name "Append to file: " (default-directory)))))) + (apply 'default-dir-real-append-to-file start end filename args)) + +(efs-overwrite-fn "default-dir" 'append-to-file 'default-dir-append-to-file) + +(defun default-dir-delete-file (file) + "Documented as original" + (interactive + (list + (expand-file-name + (read-file-name "Delete file: " (default-directory) nil t)))) + (default-dir-real-delete-file file)) + +(efs-overwrite-fn "default-dir" 'delete-file 'default-dir-delete-file) + +;;; end of default-dir.el