[Emacs-diffs] Changes to emacs/lisp/dirtrack.el,v

[Stefan Monnier]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        06/07/07 15:14:47

Index: dirtrack.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/dirtrack.el,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- dirtrack.el 6 Feb 2006 14:33:32 -0000       1.18
+++ dirtrack.el 7 Jul 2006 15:14:46 -0000       1.19
@@ -65,10 +65,7 @@
 ;; 3) Add a hook to shell-mode to enable the directory tracking:
 ;;
 ;; (add-hook 'shell-mode-hook
-;;   (function (lambda ()
-;;           (setq comint-preoutput-filter-functions
-;;                 (append (list 'dirtrack)
-;;                         comint-preoutput-filter-functions)))))
+;;   (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'.
@@ -132,7 +129,7 @@
   :group 'shell)
 
 (defcustom dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
-  "*List for directory tracking.
+  "List for directory tracking.
 First item is a regexp that describes where to find the path in a prompt.
 Second is a number, the regexp group to match.  Optional third item is
 whether the prompt is multi-line.  If nil or omitted, prompt is assumed to
@@ -140,77 +137,58 @@
   :group 'dirtrack
   :type  '(sexp (regexp  :tag "Prompt Expression")
                (integer :tag "Regexp Group")
-               (boolean :tag "Multiline Prompt")
-               )
-  )
+               (boolean :tag "Multiline Prompt")))
 
 (make-variable-buffer-local 'dirtrack-list)
 
 (defcustom dirtrack-debug nil
-  "*If non-nil, the function `dirtrack' will report debugging info."
+  "If non-nil, the function `dirtrack' will report debugging info."
   :group 'dirtrack
-  :type  'boolean
-  )
+  :type  'boolean)
 
 (defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
   "Buffer to write directory tracking debug information."
   :group 'dirtrack
-  :type  'string
-  )
+  :type  'string)
 
 (defcustom dirtrackp t
-  "*If non-nil, directory tracking via `dirtrack' is enabled."
+  "If non-nil, directory tracking via `dirtrack' is enabled."
   :group 'dirtrack
-  :type  'boolean
-  )
+  :type  'boolean)
 
 (make-variable-buffer-local 'dirtrackp)
 
 (defcustom dirtrack-directory-function
   (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
       'dirtrack-windows-directory-function
-    'dirtrack-default-directory-function)
-  "*Function to apply to the prompt directory for comparison purposes."
+    'file-name-as-directory)
+  "Function to apply to the prompt directory for comparison purposes."
   :group 'dirtrack
-  :type  'function
-  )
+  :type  'function)
 
 (defcustom dirtrack-canonicalize-function
   (if (memq system-type (list 'ms-dos 'windows-nt 'cygwin))
       'downcase 'identity)
-  "*Function to apply to the default directory for comparison purposes."
+  "Function to apply to the default directory for comparison purposes."
   :group 'dirtrack
-  :type  'function
-  )
+  :type  'function)
 
 (defcustom dirtrack-directory-change-hook nil
   "Hook that is called when a directory change is made."
   :group 'dirtrack
-  :type 'hook
-  )
+  :type 'hook)
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun dirtrack-default-directory-function (dir)
-  "Return a canonical directory for comparison purposes.
-Such a directory ends with a forward slash."
-  (let ((directory dir))
-    (if (not (char-equal ?/ (string-to-char (substring directory -1))))
-       (concat directory "/")
-      directory)))
 
 (defun dirtrack-windows-directory-function (dir)
   "Return a canonical directory for comparison purposes.
 Such a directory is all lowercase, has forward-slashes as delimiters,
 and ends with a forward slash."
-  (let ((directory dir))
-    (setq directory (downcase (dirtrack-replace-slash directory t)))
-    (if (not (char-equal ?/ (string-to-char (substring directory -1))))
-       (concat directory "/")
-      directory)))
+  (file-name-as-directory (downcase (subst-char-in-string ?\\ ?/ dir))))
 
 (defun dirtrack-cygwin-directory-function (dir)
   "Return a canonical directory taken from a Cygwin path for comparison 
purposes."
@@ -218,30 +196,13 @@
       (concat (match-string 1 dir) ":" (match-string 2 dir))
     dir))
 
-(defconst dirtrack-forward-slash  (regexp-quote "/"))
-(defconst dirtrack-backward-slash (regexp-quote "\\"))
-
-(defun dirtrack-replace-slash (string &optional opposite)
-  "Replace forward slashes with backwards ones.
-If additional argument is non-nil, replace backwards slashes with
-forward ones."
-  (let ((orig     (if opposite
-                     dirtrack-backward-slash
-                   dirtrack-forward-slash))
-       (replace  (if opposite
-                     dirtrack-forward-slash
-                   dirtrack-backward-slash))
-       (newstring string)
-       )
-    (while (string-match orig newstring)
-      (setq newstring (replace-match replace nil t newstring)))
-  newstring))
-
 ;; Copied from shell.el
 (defun dirtrack-toggle ()
   "Enable or disable Dirtrack directory tracking in a shell buffer."
   (interactive)
-  (setq dirtrackp (not dirtrackp))
+  (if (setq dirtrackp (not dirtrackp))
+      (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")))
 
 (defun dirtrack-debug-toggle ()
@@ -273,32 +234,25 @@
 function `dirtrack-debug-toggle' to turn on debugging output.
 
 You can enable directory tracking by adding this function to
-`comint-output-filter-functions'.
-"
-  (if (null dirtrackp)
+`comint-output-filter-functions'."
+  (if (or (null dirtrackp)
+          ;; No output?
+          (eq (point) (point-min)))
       nil
     (let (prompt-path
-         matched
          (current-dir default-directory)
          (dirtrack-regexp    (nth 0 dirtrack-list))
          (match-num          (nth 1 dirtrack-list))
-         (multi-line         (nth 2 dirtrack-list))
-         )
-      ;; No output?
-      (if (eq (point) (point-min))
-         nil
+          ;; Currently unimplemented, it seems.  --Stef
+         (multi-line         (nth 2 dirtrack-list)))
        (save-excursion
-         (setq matched (string-match dirtrack-regexp input)))
          ;; No match
-         (if (null matched)
+        (if (null (string-match dirtrack-regexp input))
              (and dirtrack-debug
                   (dirtrack-debug-message
                    (format
-                    "Input `%s' failed to match regexp: %s"
-                   input dirtrack-regexp)))
-           (setq prompt-path
-                 (substring input
-                  (match-beginning match-num) (match-end match-num)))
+                   "Input `%s' failed to match `dirtrack-regexp'" input)))
+          (setq prompt-path (match-string match-num input))
            ;; Empty string
            (if (not (> (length prompt-path) 0))
                (and dirtrack-debug
@@ -335,5 +289,5 @@
 
 (provide 'dirtrack)
 
-;;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a
+;; arch-tag: 168de071-be88-4937-aff6-2aba9f328d5a
 ;;; dirtrack.el ends here