;;  -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File:         default-dir.el
;; RCS:
;; Version:      $Revision: 1.2 $
;; 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-variant '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