]> code.delx.au - gnu-emacs/blobdiff - lisp/ido.el
(ibuffer-compressed-file-name-regexp): Undo previous
[gnu-emacs] / lisp / ido.el
index c1d40df5c699a81df1eab0630590ab63ce09a936..a622a7e6275b60c9818145deca5666101ebe6bb3 100644 (file)
@@ -360,7 +360,10 @@ use either \\[customize] or the function `ido-mode'."
   :initialize 'custom-initialize-set
   :require 'ido
   :link '(emacs-commentary-link "ido.el")
-  :set-after '(ido-save-directory-list-file)
+  :set-after '(ido-save-directory-list-file
+              ;; This will clear ido-unc-hosts-cache, so set it
+              ;; before loading history file.
+              ido-unc-hosts)
   :type '(choice (const :tag "Turn on only buffer" buffer)
                  (const :tag "Turn on only file" file)
                  (const :tag "Turn on both buffer and file" both)
@@ -613,6 +616,7 @@ A tramp file name uses the following syntax: /method:user@host:filename."
 
 (defcustom ido-cache-ftp-work-directory-time 1.0
   "*Maximum time to cache contents of an ftp directory (in hours).
+Use C-l in prompt to refresh list.
 If zero, ftp directories are not cached."
   :type 'number
   :group 'ido)
@@ -629,10 +633,44 @@ equivalent function, e.g. `find-file' rather than `ido-find-file'."
   :type '(repeat regexp)
   :group 'ido)
 
+(defvar ido-unc-hosts-cache t
+  "Cached value from `ido-unc-hosts' function.")
+
+(defcustom ido-unc-hosts nil
+  "*List of known UNC host names to complete after initial //.
+If value is a function, that function is called to search network for
+hosts on first use of UNC path."
+  :type '(choice (repeat :tag "List of UNC host names" string)
+                (function-item :tag "Use `NET VIEW'"
+                               :value ido-unc-hosts-net-view)
+                (function :tag "Your own function"))
+  :set #'(lambda (symbol value)
+          (set symbol value)
+          (setq ido-unc-hosts-cache t))
+  :group 'ido)
+
+(defcustom ido-downcase-unc-hosts t
+  "*Non-nil if UNC host names should be downcased."
+  :type 'boolean
+  :group 'ido)
+
+(defcustom ido-ignore-unc-host-regexps nil
+  "*List of regexps matching UNC hosts to ignore.
+Case is ignored if `ido-downcase-unc-hosts' is set."
+  :type '(repeat regexp)
+  :group 'ido)
+
+(defcustom ido-cache-unc-host-shares-time 8.0
+  "*Maximum time to cache shares of an UNC host (in hours).
+Use C-l in prompt to refresh list.
+If zero, UNC host shares are not cached."
+  :type 'number
+  :group 'ido)
+
 (defcustom ido-max-work-file-list 10
   "*Maximum number of names of recently opened files to record.
 This is the list the file names (sans directory) which have most recently
-been opened. See `ido-work-file-list' and `ido-save-directory-list-file'."
+been opened.  See `ido-work-file-list' and `ido-save-directory-list-file'."
   :type 'integer
   :group 'ido)
 
@@ -878,7 +916,7 @@ Must be set before enabling ido mode."
   :group 'ido)
 
 (defcustom ido-read-file-name-as-directory-commands '()
-  "List of commands which uses read-file-name to read a directory name.
+  "List of commands which uses `read-file-name' to read a directory name.
 When `ido-everywhere' is non-nil, the commands in this list will read
 the directory using `ido-read-directory-name'."
   :type '(repeat symbol)
@@ -975,7 +1013,7 @@ Copied from `icomplete-eoinput'.")
   "List of files currently matching `ido-text'.")
 
 (defvar ido-report-no-match t
-  "Report [No Match] when no completions matches ido-text.")
+  "Report [No Match] when no completions matches `ido-text'.")
 
 (defvar ido-exit nil
   "Flag to monitor how `ido-find-file' exits.
@@ -1098,11 +1136,68 @@ it doesn't interfere with other minibuffer usage.")
          (pop-to-buffer b t t)
          (setq truncate-lines t)))))
 
+(defun ido-unc-hosts (&optional query)
+  "Return list of UNC host names."
+  (let ((hosts
+        (cond
+         ((listp ido-unc-hosts)
+          ido-unc-hosts)               ;; static list or nil
+         ((listp ido-unc-hosts-cache)
+          ido-unc-hosts-cache) ;; result of net search
+         ((and query (fboundp ido-unc-hosts))
+          (message (propertize "Searching for UNC hosts..." 'face 'highlight))
+          (setq ido-unc-hosts-cache (funcall ido-unc-hosts))
+          (message nil)
+          ido-unc-hosts-cache)
+         (query
+          (setq ido-unc-hosts-cache nil))
+         (t (fboundp ido-unc-hosts)))))
+    (when query
+      (let ((case-fold-search ido-downcase-unc-hosts)
+           res host re-list re)
+       (while hosts
+         (setq host (car hosts)
+               hosts (cdr hosts)
+               re-list (and ido-process-ignore-lists
+                            ido-ignore-unc-host-regexps))
+         (while re-list
+           (setq re (car re-list)
+                 re-list (cdr re-list))
+           (if (string-match re host)
+               (setq re-list nil
+                     host nil)))
+         (when host
+           (when ido-downcase-unc-hosts
+             (setq host (downcase host)))
+           (setq res (cons host res))))
+       (setq hosts (sort res #'string<))))
+    hosts))
+
+(defun ido-unc-hosts-net-view ()
+  "Query network for list of UNC host names using `NET VIEW'."
+  (let (hosts)
+    (with-temp-buffer
+      (shell-command "net view" t)
+      (goto-char (point-min))
+      (while (re-search-forward "^\\\\\\\\\\([[:graph:]]+\\)" nil t)
+       (setq hosts (cons (match-string 1) hosts))))
+    hosts))
+
 (defun ido-is-tramp-root (&optional dir)
   (and ido-enable-tramp-completion
        (string-match "\\`/[^/]+[@:]\\'"
                     (or dir ido-current-directory))))
 
+(defun ido-is-unc-root (&optional dir)
+  (and (ido-unc-hosts)
+       (string-equal "//"
+                    (or dir ido-current-directory))))
+
+(defun ido-is-unc-host (&optional dir)
+  (and (ido-unc-hosts)
+       (string-match "\\`//[^/]+/\\'"
+                    (or dir ido-current-directory))))
+
 (defun ido-is-root-directory (&optional dir)
   (setq dir (or dir ido-current-directory))
   (or
@@ -1148,6 +1243,12 @@ it doesn't interfere with other minibuffer usage.")
        (or (not time)
           (< (- (ido-time-stamp) time) ido-cache-ftp-work-directory-time))))
 
+(defun ido-cache-unc-valid (&optional time)
+  (and (numberp ido-cache-unc-host-shares-time)
+       (> ido-cache-unc-host-shares-time 0)
+       (or (not time)
+          (< (- (ido-time-stamp) time) ido-cache-unc-host-shares-time))))
+
 (defun ido-may-cache-directory (&optional dir)
   (setq dir (or dir ido-current-directory))
   (cond
@@ -1157,10 +1258,11 @@ it doesn't interfere with other minibuffer usage.")
         (or ido-enable-tramp-completion
             (memq system-type '(windows-nt ms-dos))))
     nil)
-   ((not (ido-is-ftp-directory dir))
-    t)
-   ((ido-cache-ftp-valid)
-    t)))
+   ((ido-is-unc-host dir)
+    (ido-cache-unc-valid))
+   ((ido-is-ftp-directory dir)
+    (ido-cache-ftp-valid))
+   (t t)))
 
 (defun ido-pp (list &optional sep)
   (let ((print-level nil) (eval-expression-print-level nil)
@@ -1191,6 +1293,9 @@ it doesn't interfere with other minibuffer usage.")
            (ido-pp 'ido-work-directory-list)
            (ido-pp 'ido-work-file-list)
            (ido-pp 'ido-dir-file-cache "\n\n ")
+           (if (listp ido-unc-hosts-cache)
+               (ido-pp 'ido-unc-hosts-cache)
+             (insert "\n;; ----- ido-unc-hosts-cache -----\nt\n"))
            (insert "\n")
            (write-file ido-save-directory-list-file nil))
        (kill-buffer buf)))))
@@ -1212,7 +1317,8 @@ With prefix argument, reload history unconditionally."
                    (setq ido-last-directory-list (read (current-buffer))
                          ido-work-directory-list (read (current-buffer))
                          ido-work-file-list (read (current-buffer))
-                         ido-dir-file-cache (read (current-buffer)))
+                         ido-dir-file-cache (read (current-buffer))
+                         ido-unc-hosts-cache (read (current-buffer)))
                  (error nil)))
            (kill-buffer buf)))))
   (ido-wash-history))
@@ -1262,15 +1368,21 @@ Removes badly formatted data and ignored directories."
                            (and
                             (stringp dir)
                             (consp time)
-                            (if (integerp (car time))
-                                (and (/= (car time) 0)
-                                     (integerp (car (cdr time)))
-                                     (/= (car (cdr time)) 0)
-                                     (ido-may-cache-directory dir))
-                              (and (eq (car time) 'ftp)
-                                   (numberp (cdr time))
+                            (cond
+                             ((integerp (car time))
+                              (and (/= (car time) 0)
+                                   (integerp (car (cdr time)))
+                                   (/= (car (cdr time)) 0)
+                                   (ido-may-cache-directory dir)))
+                             ((eq (car time) 'ftp)
+                              (and (numberp (cdr time))
                                    (ido-is-ftp-directory dir)
                                    (ido-cache-ftp-valid (cdr time))))
+                             ((eq (car time) 'unc)
+                              (and (numberp (cdr time))
+                                   (ido-is-unc-host dir)
+                                   (ido-cache-unc-valid (cdr time))))
+                             (t nil))
                             (let ((s files) (ok t))
                               (while s
                                 (if (stringp (car s))
@@ -1535,6 +1647,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
   ;; connect on incomplete tramp paths (after entring just method:).
   (let ((ido-enable-tramp-completion nil))
     (and (ido-final-slash dir)
+        (not (ido-is-unc-host dir))
         (file-directory-p dir)
         (not (file-readable-p dir)))))
 
@@ -1545,6 +1658,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
   (let ((ido-enable-tramp-completion nil))
     (and (numberp ido-max-directory-size)
         (ido-final-slash dir)
+        (not (ido-is-unc-host dir))
         (file-directory-p dir)
         (> (nth 7 (file-attributes dir)) ido-max-directory-size))))
 
@@ -1560,8 +1674,18 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
     (unless (and ido-enable-tramp-completion
                 (string-match "\\`/[^/]*@\\'" dir))
       (setq dir (ido-final-slash dir t))))
-  (if (equal dir ido-current-directory)
-      nil
+  (if (get-buffer ido-completion-buffer)
+      (kill-buffer ido-completion-buffer))
+  (cond
+   ((equal dir ido-current-directory)
+    nil)
+   ((ido-is-unc-root dir)
+    (ido-trace "unc" dir)
+    (setq ido-current-directory dir)
+    (setq ido-directory-nonreadable nil)
+    (setq ido-directory-too-big nil)
+    t)
+   (t
     (ido-trace "cd" dir)
     (setq ido-current-directory dir)
     (if (get-buffer ido-completion-buffer)
@@ -1569,7 +1693,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
     (setq ido-directory-nonreadable (ido-nonreadable-directory-p dir))
     (setq ido-directory-too-big (and (not ido-directory-nonreadable)
                                     (ido-directory-too-big-p dir)))
-    t))
+    t)))
 
 (defun ido-set-current-home (&optional dir)
   ;; Set ido's current directory to user's home directory
@@ -1651,7 +1775,7 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
 ;;       the relevant function is called (find-file, write-file, etc).
 
 (defun ido-read-internal (item prompt history &optional default require-match initial)
-  "Perform the ido-read-buffer and ido-read-file-name functions.
+  "Perform the `ido-read-buffer' and `ido-read-file-name' functions.
 Return the name of a buffer or file selected.
 PROMPT is the prompt to give to the user.
 DEFAULT if given is the default directory to start with.
@@ -1940,6 +2064,7 @@ If INITIAL is non-nil, it specifies the initial input string."
              (setq ido-exit 'fallback
                    done t)
            (setq ido-set-default-item t)))
+
         ((or (string-match "[/\\][^/\\]" ido-selected)
              (and (memq system-type '(windows-nt ms-dos))
                   (string-match "\\`.:" ido-selected)))
@@ -2474,7 +2599,9 @@ timestamp has not changed (e.g. with ftp or on Windows)."
   (interactive)
   (if (and ido-mode (eq ido-cur-item 'file))
       (progn
-       (ido-remove-cached-dir ido-current-directory)
+       (if (ido-is-unc-root)
+           (setq ido-unc-hosts-cache t)
+         (ido-remove-cached-dir ido-current-directory))
        (setq ido-text-init ido-text)
        (setq ido-rotate-temp t)
        (setq ido-exit 'refresh)
@@ -3184,36 +3311,52 @@ for first matching file."
 (defun ido-file-name-all-completions (dir)
   ;; Return name of all files in DIR
   ;; Uses and updates ido-dir-file-cache
-  (if (and (numberp ido-max-dir-file-cache) (> ido-max-dir-file-cache 0)
-          (stringp dir) (> (length dir) 0)
-          (ido-may-cache-directory dir))
-      (let* ((cached (assoc dir ido-dir-file-cache))
+  (cond
+   ((ido-is-unc-root dir)
+    (mapcar
+     (lambda (host)
+       (if (string-match "/\\'" host) host (concat host "/")))
+     (ido-unc-hosts t)))
+   ((and (numberp ido-max-dir-file-cache) (> ido-max-dir-file-cache 0)
+        (stringp dir) (> (length dir) 0)
+        (ido-may-cache-directory dir))
+    (let* ((cached (assoc dir ido-dir-file-cache))
             (ctime (nth 1 cached))
             (ftp (ido-is-ftp-directory dir))
-            (attr (if ftp nil (file-attributes dir)))
+            (unc (ido-is-unc-host dir))
+            (attr (if (or ftp unc) nil (file-attributes dir)))
             (mtime (nth 5 attr))
             valid)
        (when cached        ; should we use the cached entry ?
-         (if ftp
-             (setq valid (and (eq (car ctime) 'ftp)
-                              (ido-cache-ftp-valid (cdr ctime))))
+         (cond
+          (ftp
+           (setq valid (and (eq (car ctime) 'ftp)
+                            (ido-cache-ftp-valid (cdr ctime)))))
+          (unc
+           (setq valid (and (eq (car ctime) 'unc)
+                            (ido-cache-unc-valid (cdr ctime)))))
+          (t
            (if attr
                (setq valid (and (= (car ctime) (car mtime))
-                                (= (car (cdr ctime)) (car (cdr mtime)))))))
-         (if (not valid)
-             (setq ido-dir-file-cache (delq cached ido-dir-file-cache)
-                   cached nil)))
+                                (= (car (cdr ctime)) (car (cdr mtime))))))))
+         (unless valid
+           (setq ido-dir-file-cache (delq cached ido-dir-file-cache)
+                 cached nil)))
        (unless cached
-         (if (and ftp (file-readable-p dir))
-             (setq mtime (cons 'ftp (ido-time-stamp))))
+         (cond
+          (unc
+           (setq mtime (cons 'unc (ido-time-stamp))))
+          ((and ftp (file-readable-p dir))
+           (setq mtime (cons 'ftp (ido-time-stamp)))))
          (if mtime
              (setq cached (cons dir (cons mtime (ido-file-name-all-completions-1 dir)))
                    ido-dir-file-cache (cons cached ido-dir-file-cache)))
          (if (> (length ido-dir-file-cache) ido-max-dir-file-cache)
              (setcdr (nthcdr (1- ido-max-dir-file-cache) ido-dir-file-cache) nil)))
        (and cached
-            (cdr (cdr cached))))
-    (ido-file-name-all-completions-1 dir)))
+            (cdr (cdr cached)))))
+   (t
+    (ido-file-name-all-completions-1 dir))))
 
 (defun ido-remove-cached-dir (dir)
   ;; Remove dir from ido-dir-file-cache
@@ -3227,7 +3370,8 @@ for first matching file."
 (defun ido-make-file-list-1 (dir &optional merged)
   ;; Return list of non-ignored files in DIR
   ;; If MERGED is non-nil, each file is cons'ed with DIR
-  (and (or (ido-is-tramp-root dir) (file-directory-p dir))
+  (and (or (ido-is-tramp-root dir) (ido-is-unc-root dir)
+          (file-directory-p dir))
        (delq nil
             (mapcar
              (lambda (name)
@@ -3668,7 +3812,7 @@ default is to show it in the same window, unless it is already visible
 in another frame.
 
 As you type in a string, all of the buffers matching the string are
-displayed if substring-matching is used \(default). Look at
+displayed if substring-matching is used \(default).  Look at
 `ido-enable-prefix' and `ido-toggle-prefix'.  When you have found the
 buffer you want, it can then be selected.  As you type, most keys have
 their normal keybindings, except for the following: \\<ido-buffer-completion-map>
@@ -3691,7 +3835,7 @@ in a separate window.
 \\[ido-toggle-prefix] Toggle between substring and prefix matching.
 \\[ido-toggle-case] Toggle case-sensitive searching of buffer names.
 \\[ido-completion-help] Show list of matching buffers in separate window.
-\\[ido-enter-find-file] Drop into ido-find-file.
+\\[ido-enter-find-file] Drop into `ido-find-file'.
 \\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
 \\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'."
   (interactive)
@@ -3956,10 +4100,16 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
          )
 
         ((= (length contents) 1)
-         (when (and (ido-is-tramp-root) (string-equal contents "/"))
+         (cond
+          ((and (ido-is-tramp-root) (string-equal contents "/"))
            (ido-set-current-directory ido-current-directory contents)
            (setq refresh t))
-         )
+          ((and (ido-unc-hosts) (string-equal contents "/")
+                (let ((ido-enable-tramp-completion nil))
+                  (ido-is-root-directory)))
+           (ido-set-current-directory "//")
+           (setq refresh t))
+         ))
 
         ((and (string-match (if ido-enable-tramp-completion "..[:@]\\'" "..:\\'") contents)
               (ido-is-root-directory)) ;; Ange-ftp or tramp