Add ido and find-file-in-repo to blue

1 files changed, 212 insertions, 0 deletions

diff --git a/site-lisp/find-file-in-repository.el b/site-lisp/find-file-in-repository.el
new file mode 100644
index 0000000..3b450ea
--- /dev/null
+++ b/site-lisp/find-file-in-repository.el
@@ -0,0 +1,212 @@
+;;; find-file-in-repository.el --- Quickly find files in a git, mercurial or other repository
+
+;; Copyright (C) 2012  Samuel Hoffstaetter
+
+;; Author: Samuel Hoffstaetter <samuel@hoffstaetter.com>
+;; Keywords: files, convenience, repository, project, source control
+;; URL: https://github.com/hoffstaetter/find-file-in-repository
+;; Version: 1.3
+
+;; 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 3 of the License, 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides a drop-in replacement for find-file (ie. the
+;; "C-x f" command), that auto-completes all files in the current git,
+;; mercurial, or other type of repository. When outside of a
+;; repository, find-file-in-repository conveniently drops back to
+;; using find-file, (or ido-find-file), which makes it a suitable
+;; replacement for the "C-x f" keybinding.
+;;
+;; It is similar to, but faster and more robust than the find-file-in-project
+;; package. It relies on git/mercurial/etc to provide fast cached file name
+;; completions, which means that repository features such as
+;; .gitignore/.hgignore/etc are fully supported out of the box.
+;;
+;; This library currently has support for:
+;;     git, mercurial, darcs, bazaar, monotone, svn
+;;
+;; Contributions for support of other repository types are welcome.
+;; Please send a pull request to
+;; https://github.com/hoffstaetter/find-file-in-repository and I will
+;; be happy to include your modifications.
+;;
+;; Recommended keybinding:
+;;    (global-set-key (kbd "C-x f") 'find-file-in-repository)
+
+;;; Code:
+
+(defun ffir-system-is-windows()
+  (or (string-equal system-type "windows-nt")
+      (string-equal system-type "ms-dos")))
+
+(defvar ffir-format-str
+  (if (ffir-system-is-windows)
+      "cd %s & %s"
+    "cd %s; %s"))
+
+(defun ffir-shell-command (command file-separator working-dir)
+  "Executes 'command' and returns the list of printed files in
+   the form '((short/file/name . full/path/to/file) ...). The
+   'file-separator' character is used to split the file names
+   printed by the shell command and is usually set to \\n or \\0"
+  (let ((command-output (shell-command-to-string
+                         (format ffir-format-str
+                                 (shell-quote-argument working-dir) command))))
+    (let ((files (delete "" (split-string command-output file-separator))))
+      (mapcar (lambda (file)
+                (cons file (expand-file-name file working-dir)))
+              files))))
+
+(defun ffir-locate-dominating-file (file name)
+  "Identical to 'locate-dominating-file' on modern Emacs. We
+  re-implement it here, since locate-dominating-file doesn't
+  accept 'name' predicates on older versions of emacs."
+  (setq file (abbreviate-file-name file))
+  (let ((root nil) try)
+    (while (not (or root
+                    (null file)
+                    (string-match locate-dominating-stop-dir-regexp file)))
+      (setq try (if (stringp name)
+                    (file-exists-p (expand-file-name name file))
+                  (funcall name file)))
+      (cond (try (setq root file))
+            ((equal file (setq file (file-name-directory
+                                     (directory-file-name file))))
+             (setq file nil))))
+    (if root (file-name-as-directory root))))
+
+(defun ffir-locate-dominating-file-top (start-directory filename)
+  "Returns the furthest ancestor directory of 'start-directory'
+   that contains a file of name 'filename'"
+  (when start-directory
+    (let ((next-directory
+           (ffir-locate-dominating-file start-directory filename)))
+      (if next-directory
+          (ffir-locate-dominating-file-top next-directory filename)
+        (expand-file-name start-directory)))))
+
+(defun ffir-directory-contains-which-file (file-list directory)
+  "Checks which of the files in 'file-list' exists inside
+  'directory'. The file-list is a list (filename . value) tuples.
+  For the first filename that exists in the directory, the
+  corresponding value is returned. If 'directory' contains none
+  of the filenames, nil is returned."
+  (when file-list
+    (let ((filename (expand-file-name (car (car file-list)) directory)))
+      (if (file-exists-p filename)
+          (cdr (car file-list))
+        (ffir-directory-contains-which-file (cdr file-list) directory)))))
+
+(defun ffir-when-ido (ido-value non-ido-value)
+  "Returns ido-value when ido is enabled, otherwise returns non-ido-value."
+  (if (and (boundp 'ido-mode) ido-mode)
+      ido-value
+    non-ido-value))
+
+(defvar ffir-avoid-HOME-repository
+  't
+  "When set to nil, find-file-in-repository will accept the
+  user's $HOME directory as a valid repository when it
+  contains a .git/.hg/_darcs/(...) file.")
+
+(defvar ffir-repository-types
+  `((".git"   . ,(lambda (dir)
+                   (ffir-shell-command
+                    ;; "git ls-files -zco --exclude-standard"     "\0" dir)))
+                    "git ls-files -zc --exclude-standard --recurse-submodules" "\0" dir)))
+    (".hg"    . ,(lambda (dir)
+                   (ffir-shell-command "hg locate -0"          "\0" dir)))
+    ("_darcs" . ,(lambda (dir)
+                   (ffir-shell-command "darcs show files -0"   "\0" dir)))
+    (".bzr"   . ,(lambda (dir)
+                   (ffir-shell-command
+                    "bzr ls --versioned --recursive -0"        "\0" dir)))
+    ("_MTN"   . ,(lambda (dir)
+                   (ffir-shell-command "mtn list known"        "\n" dir)))
+
+    ;; svn repos must be searched differently from others since
+    ;; every svn sub-directory contains a .svn folder as well
+    (".svn"   . ,(lambda (start-dir) (ffir-shell-command "svn list" "\n"
+                                      (ffir-locate-dominating-file-top
+                                       start-dir ".svn")))))
+  "List of supported repository types for find-file-in-repository.
+  The first entry in each tuple is a file name determining the
+  repository type. The second entry in the tuple is a function
+  that takes as argument the repository root, and returns the
+  list of file names tracked by the repository.")
+
+(defun ffir-ido-setup ()
+  "Add fallback bindings to ido keymap while ffir is active."
+  (define-key ido-completion-map (kbd "C-x C-f") 'ido-fallback-command)
+  (define-key ido-completion-map (kbd "C-x f") 'ido-fallback-command))
+
+(defun ffir-ido-find-file (file-list)
+  "Actually find file to open, using ido."
+  (add-hook 'ido-setup-hook 'ffir-ido-setup)
+  (unwind-protect
+      (let* ((file (ido-completing-read "Find file in repository: "
+                                        (mapcar 'car file-list)))
+             (path (or (cdr (assoc file file-list)) file)))
+        (cond
+         (file (find-file path))
+         ((eq ido-exit 'fallback) (ido-find-file))))
+    (remove-hook 'ido-setup-hook 'ffir-ido-setup)))
+
+(defun ffir-find-file (file-list)
+  "Actually find file to open, without using ido."
+  (let ((file (completing-read "Find file in repository: "
+                               (mapcar 'car file-list))))
+    (find-file (cdr (assoc file file-list)))))
+
+;;;###autoload
+(defun find-file-in-repository ()
+  "find-file-in-repository will autocomplete all files in the
+   current git, mercurial or other type of repository, using
+   ido-find-file when available. When the current file is not
+   located inside of any repository, falls back on a regular
+   find-file operation."
+  (interactive)
+  (let ((repo-directory (ffir-locate-dominating-file
+                         default-directory
+                         (lambda (directory)
+                           (ffir-directory-contains-which-file
+                            ffir-repository-types directory))))
+        (home-dir (format "%s/" (getenv "HOME"))))
+    ;; check whether we are in a supported repository type
+    (if (and repo-directory
+             (not (and ffir-avoid-HOME-repository
+                       (equal (expand-file-name repo-directory)
+                              (expand-file-name home-dir)))))
+        ;; auto-complete files tracked by the repository system
+        (let* ((repo-directory (expand-file-name repo-directory))
+               (file-list (funcall (ffir-directory-contains-which-file
+                                    ffir-repository-types repo-directory)
+                                   repo-directory)))
+          (funcall (ffir-when-ido 'ffir-ido-find-file 'ffir-find-file)
+                   file-list))
+      ;; fall back on regular find-file when no repository can be found
+      (let ((find-file (ffir-when-ido 'ido-find-file 'find-file)))
+        (command-execute find-file)))))
+
+;;;###autoload
+(defalias 'ffir 'find-file-in-repository)
+
+;;;###autoload
+(progn
+  (put 'ffir-repository-types 'safe-local-variable 'listp)
+  (put 'ffir-avoid-HOME-repository 'safe-local-variable 'booleanp))
+
+(provide 'find-file-in-repository)
+;;; find-file-in-repository.el ends here