From 506ab42e447eeea7715818599e34a90a42b1a907 Mon Sep 17 00:00:00 2001 From: Joel Klinghed Date: Tue, 22 Jan 2019 13:18:49 +0100 Subject: Add ido and find-file-in-repo to blue --- site-lisp/find-file-in-repository.el | 212 +++++++++++++++++++++++++++++++++++ 1 file changed, 212 insertions(+) create mode 100644 site-lisp/find-file-in-repository.el (limited to 'site-lisp/find-file-in-repository.el') 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 +;; 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 . + +;;; 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 -- cgit v1.2.3-70-g09d2