X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e91081eb9e3d6074d3ba5ba2fae1d902601d56e6..a5a79894f66d9e32df412322f5420dcf66a88b83:/lisp/dirtrack.el?ds=sidebyside diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 5a508b31c5..6d9b5a00f3 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -1,7 +1,7 @@ ;;; dirtrack.el --- Directory Tracking by watching the prompt ;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, -;; 2006 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Peter Breton ;; Created: Sun Nov 17 1996 @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs 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 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; 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, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -57,18 +55,12 @@ ;; add 't' as a third element. Note that some of the functions in ;; 'comint.el' assume a single-line prompt (eg, comint-bol). ;; -;; Determining this information may take some experimentation. Setting -;; the variable `dirtrack-debug' may help; it causes the directory-tracking -;; filter to log messages to the buffer `dirtrack-debug-buffer'. You can easily -;; toggle this setting with the `dirtrack-debug-toggle' function. +;; Determining this information may take some experimentation. Using +;; `dirtrack-debug-mode' may help; it causes the directory-tracking +;; filter to log messages to the buffer `dirtrack-debug-buffer'. ;; -;; 3) Add a hook to shell-mode to enable the directory tracking: -;; -;; (add-hook 'shell-mode-hook -;; (lambda () (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t))) -;; -;; You may wish to turn ordinary shell tracking off by calling -;; `shell-dirtrack-toggle' or setting `shell-dirtrackp'. +;; 3) Activate `dirtrack-mode'. You may wish to turn ordinary shell +;; tracking off by calling `shell-dirtrack-mode'. ;; ;; Examples: ;; @@ -147,7 +139,7 @@ be on a single line." :type 'boolean) (defcustom dirtrack-debug-buffer "*Directory Tracking Log*" - "Buffer to write directory tracking debug information." + "Buffer in which to write directory tracking debug information." :group 'dirtrack :type 'string) @@ -196,49 +188,53 @@ and ends with a forward slash." (concat (match-string 1 dir) ":" (match-string 2 dir)) dir)) -;; Copied from shell.el -(defun dirtrack-toggle () - "Enable or disable Dirtrack directory tracking in a shell buffer." - (interactive) - (if (setq dirtrackp (not dirtrackp)) + +;;;###autoload +(define-minor-mode dirtrack-mode + "Enable or disable Dirtrack directory tracking in a shell buffer. +This method requires that your shell prompt contain the full +current working directory at all times, and that `dirtrack-list' +is set to match the prompt. This is an alternative to +`shell-dirtrack-mode', which works differently, by tracking `cd' +and similar commands which change the shell working directory." + nil nil nil + (if dirtrack-mode (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) - (remove-hook 'comint-preoutput-filter-functions 'dirtrack t)) - (message "Directory tracking %s" (if dirtrackp "ON" "OFF"))) + (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) -(defun dirtrack-debug-toggle () +(define-obsolete-function-alias 'dirtrack-toggle 'dirtrack-mode "23.1") +(define-obsolete-variable-alias 'dirtrackp 'dirtrack-mode "23.1") + + +(define-minor-mode dirtrack-debug-mode "Enable or disable Dirtrack debugging." - (interactive) - (setq dirtrack-debug (not dirtrack-debug)) - (message "Directory debugging %s" (if dirtrack-debug "ON" "OFF")) - (and dirtrack-debug - (display-buffer (get-buffer-create dirtrack-debug-buffer)))) + nil nil nil + (if dirtrack-debug-mode + (display-buffer (get-buffer-create dirtrack-debug-buffer)))) + +(define-obsolete-function-alias 'dirtrack-debug-toggle 'dirtrack-debug-mode + "23.1") +(define-obsolete-variable-alias 'dirtrack-debug 'dirtrack-debug-mode "23.1") + (defun dirtrack-debug-message (string) - (let ((buf (current-buffer)) - (debug-buf (get-buffer-create dirtrack-debug-buffer)) - ) - (set-buffer debug-buf) - (goto-char (point-max)) - (insert (concat string "\n")) - (set-buffer buf) - )) + "Insert string at the end of `dirtrack-debug-buffer'." + (when dirtrack-debug-mode + (with-current-buffer (get-buffer-create dirtrack-debug-buffer) + (goto-char (point-max)) + (insert (concat string "\n"))))) ;;;###autoload (defun dirtrack (input) "Determine the current directory by scanning the process output for a prompt. The prompt to look for is the first item in `dirtrack-list'. -You can toggle directory tracking by using the function `dirtrack-toggle'. +You can toggle directory tracking by using the function `dirtrack-mode'. If directory tracking does not seem to be working, you can use the -function `dirtrack-debug-toggle' to turn on debugging output. - -You can enable directory tracking by adding this function to -`comint-output-filter-functions'." - (if (or (null dirtrackp) - ;; No output? - (eq (point) (point-min))) - nil +function `dirtrack-debug-mode' to turn on debugging output." + (unless (or (null dirtrack-mode) + (eq (point) (point-min))) ; no output? (let (prompt-path (current-dir default-directory) (dirtrack-regexp (nth 0 dirtrack-list)) @@ -247,40 +243,31 @@ You can enable directory tracking by adding this function to (multi-line (nth 2 dirtrack-list))) (save-excursion ;; No match - (if (null (string-match dirtrack-regexp input)) - (and dirtrack-debug - (dirtrack-debug-message - (format - "Input `%s' failed to match `dirtrack-regexp'" input))) + (if (not (string-match dirtrack-regexp input)) + (dirtrack-debug-message + (format "Input `%s' failed to match `dirtrack-list'" input)) (setq prompt-path (match-string match-num input)) ;; Empty string (if (not (> (length prompt-path) 0)) - (and dirtrack-debug - (dirtrack-debug-message "Match is empty string")) + (dirtrack-debug-message "Match is empty string") ;; Transform prompts into canonical forms (setq prompt-path (funcall dirtrack-directory-function - prompt-path)) - (setq current-dir (funcall dirtrack-canonicalize-function + prompt-path) + current-dir (funcall dirtrack-canonicalize-function current-dir)) - (and dirtrack-debug - (dirtrack-debug-message - (format - "Prompt is %s\nCurrent directory is %s" - prompt-path current-dir))) + (dirtrack-debug-message + (format "Prompt is %s\nCurrent directory is %s" + prompt-path current-dir)) ;; Compare them (if (or (string= current-dir prompt-path) - (string= current-dir - (abbreviate-file-name prompt-path))) - (and dirtrack-debug - (dirtrack-debug-message - (format "Not changing directory"))) + (string= current-dir (abbreviate-file-name prompt-path))) + (dirtrack-debug-message (format "Not changing directory")) ;; It's possible that Emacs will think the directory ;; won't exist (eg, rlogin buffers) (if (file-accessible-directory-p prompt-path) ;; Change directory (and (shell-process-cd prompt-path) (run-hooks 'dirtrack-directory-change-hook) - dirtrack-debug (dirtrack-debug-message (format "Changing directory to %s" prompt-path))) (error "Directory %s does not exist" prompt-path)))