├── .gitignore ├── Makefile └── git-annex.el /.gitignore: -------------------------------------------------------------------------------- 1 | /git-annex.elc 2 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | elsrc=git-annex.el 2 | elobj=$(elsrc:.el=.elc) 3 | 4 | all: $(elobj) 5 | 6 | EMACS=emacs 7 | EMACSFLAGS=--batch --quick --no-init-file 8 | 9 | %.elc: %.el 10 | $(EMACS) $(EMACSFLAGS) --eval '(byte-compile-file "$<")' 11 | 12 | clean: 13 | -rm -f --verbose $(elobj) 14 | 15 | .PHONY: all clean 16 | -------------------------------------------------------------------------------- /git-annex.el: -------------------------------------------------------------------------------- 1 | ;;; git-annex.el --- Mode for easy editing of git-annex'd files 2 | 3 | ;; Copyright (C) 2012 John Wiegley 4 | 5 | ;; Author: John Wiegley 6 | ;; Created: 20 Oct 2012 7 | ;; Version: 1.1 8 | ;; Keywords: files data git annex 9 | ;; X-URL: https://github.com/jwiegley/git-annex-el 10 | 11 | ;; This program is free software; you can redistribute it and/or 12 | ;; modify it under the terms of the GNU General Public License as 13 | ;; published by the Free Software Foundation; either version 2, or (at 14 | ;; your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, but 17 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 | ;; General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the 23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 | ;; Boston, MA 02111-1307, USA. 25 | 26 | ;;; Commentary: 27 | 28 | ;; Typing C-x C-q in an annexed file buffer causes Emacs to run "git annex 29 | ;; edit". When the buffer is killed Emacs will run "git annex add && git 30 | ;; commit -m Updated". 31 | ;; 32 | ;; Dired has been extended to not show Annex symlinks, but instead to color 33 | ;; annexed files green (and preserve the "l" in the file modes). You have the 34 | ;; following commands available in dired-mode on all marked files (or the 35 | ;; current file): 36 | ;; 37 | ;; @ a Add file to Git annex 38 | ;; @ e Edit an annexed file 39 | 40 | ;;; Code: 41 | 42 | (eval-when-compile 43 | (require 'dired nil t) ; for variable dired-mode-map 44 | (require 'dired-aux nil t) ; for function dired-relist-file 45 | (require 'cl)) 46 | 47 | (defgroup git-annex nil 48 | "Mode for easy editing of git-annex'd files" 49 | :group 'files) 50 | 51 | (defcustom git-annex-commit t 52 | "If not nil, git-annex command will commit by default. 53 | 54 | otherwise you will have to commit by hand." 55 | :type 'boolean) 56 | 57 | (defsubst git-annex (&rest args) 58 | (apply #'call-process "git" nil nil nil "annex" args)) 59 | 60 | (defun git-annex-add-file () 61 | (git-annex "add" (file-relative-name buffer-file-name default-directory)) 62 | (when git-annex-commit 63 | (call-process "git" nil nil nil "commit" "-m" "Updated"))) 64 | 65 | (defun git-annex--toggle-unlock () 66 | (when (string= 67 | (vc-backend buffer-file-name) 68 | "Git" 69 | ) 70 | (when (and buffer-file-name buffer-read-only 71 | (file-symlink-p buffer-file-name)) 72 | (let ((target (nth 0 (file-attributes buffer-file-name)))) 73 | (assert (stringp target)) 74 | (when (string-match "\\.git/annex/" target) 75 | (call-process "git" nil nil nil "annex" "edit" 76 | (file-relative-name buffer-file-name default-directory)) 77 | (let ((here (point-marker))) 78 | (unwind-protect 79 | (revert-buffer nil t t) 80 | (goto-char here))) 81 | (add-hook 'kill-buffer-hook 'git-annex-add-file nil t) 82 | (setq buffer-read-only t)))) 83 | (when (and buffer-file-name (not buffer-read-only) 84 | (not (file-symlink-p buffer-file-name))) 85 | (let ((cur (current-buffer)) 86 | (name buffer-file-name) 87 | (result)) 88 | (with-temp-buffer 89 | (call-process "git" nil t nil "diff-files" "--diff-filter=T" "-G^[./]*\\.git/annex/objects/" "--name-only" "--" (file-relative-name name default-directory)) 90 | (setq result (buffer-string))) 91 | (unless (string= result "") 92 | (git-annex-add-file) 93 | (let ((here (point-marker))) 94 | (unwind-protect 95 | (revert-buffer nil t t) 96 | (goto-char here))) 97 | (setq buffer-read-only nil))))) 98 | ) 99 | 100 | (defadvice toggle-read-only (before git-annex-edit-file activate) 101 | (git-annex--toggle-unlock)) 102 | 103 | (defadvice read-only-mode (before git-annex-edit-file activate) 104 | (git-annex--toggle-unlock)) 105 | 106 | (defface git-annex-dired-annexed-available 107 | '((((class color) (background dark)) 108 | (:foreground "dark green")) 109 | (((class color) (background light)) 110 | (:foreground "dark green"))) 111 | "Face used to highlight git-annex'd files." 112 | :group 'git-annex) 113 | 114 | (defface git-annex-dired-annexed-unavailable 115 | '((((class color) (background dark)) 116 | (:foreground "firebrick")) 117 | (((class color) (background light)) 118 | (:foreground "firebrick"))) 119 | "Face used to highlight git-annex'd files." 120 | :group 'git-annex) 121 | 122 | (defvar git-annex-dired-annexed-available 'git-annex-dired-annexed-available 123 | "Face name used to highlight available git-annex'd files.") 124 | (defvar git-annex-dired-annexed-unavailable 'git-annex-dired-annexed-unavailable 125 | "Face name used to highlight unavailable git-annex'd files.") 126 | (defvar git-annex-dired-annexed-invisible 127 | '(face git-annex-dired-annexed-available invisible t) 128 | "Face name used to hide a git-annex'd file's annex path.") 129 | 130 | (defun git-annex-lookup-file (limit) 131 | (cl-loop while (re-search-forward " -> .*\\.git/annex/.+" limit t) 132 | if (file-exists-p 133 | (file-truename (dired-get-filename nil t))) 134 | return t)) 135 | 136 | (eval-after-load "dired" 137 | '(progn 138 | (add-to-list 'dired-font-lock-keywords 139 | (list " -> .*\\.git/annex/" 140 | '("\\(.+\\)\\( -> .+\\)" (dired-move-to-filename) nil 141 | (1 git-annex-dired-annexed-unavailable) 142 | (2 git-annex-dired-annexed-invisible)))) 143 | (add-to-list 'dired-font-lock-keywords 144 | (list 'git-annex-lookup-file 145 | '("\\(.+\\)\\( -> .+\\)" (dired-move-to-filename) nil 146 | (1 git-annex-dired-annexed-available) 147 | (2 git-annex-dired-annexed-invisible)))))) 148 | 149 | (defvar git-annex-dired-map 150 | (let ((map (make-keymap))) 151 | (define-key map "a" 'git-annex-dired-add-files) 152 | (define-key map "d" 'git-annex-dired-drop-files) 153 | (define-key map "e" 'git-annex-dired-edit-files) 154 | (define-key map "g" 'git-annex-dired-get-files) 155 | map) 156 | "Git-annex keymap for `dired-mode' buffers.") 157 | 158 | (add-hook 'dired-mode-hook 159 | (lambda () (define-key dired-mode-map "@" git-annex-dired-map))) 160 | 161 | (defun git-annex-dired--apply (command file-list) 162 | (let ((here (point))) 163 | (unwind-protect 164 | (mapc #'(lambda (file) 165 | (git-annex command file) 166 | (dired-relist-file (expand-file-name file))) 167 | file-list) 168 | (goto-char here)))) 169 | 170 | (defmacro git-annex-dired-do-to-files (cmd msg &optional commit-after) 171 | `(defun ,(intern (concat "git-annex-dired-" cmd "-files")) 172 | (file-list &optional arg) 173 | (interactive 174 | (let ((files (dired-get-marked-files t current-prefix-arg))) 175 | (list files current-prefix-arg))) 176 | (git-annex-dired--apply ,cmd file-list) 177 | (let ((msg (format ,msg (length file-list)))) 178 | ,(if commit-after 179 | `(when git-annex-commit (call-process "git" nil nil nil "commit" "-m" msg))) 180 | (message msg)))) 181 | 182 | (git-annex-dired-do-to-files "add" "Annex: updated %d file(s)" t) 183 | (git-annex-dired-do-to-files "drop" "Annex: dropped %d file(s)") 184 | (git-annex-dired-do-to-files "edit" "Annex: unlocked %d file(s) for editing") 185 | (git-annex-dired-do-to-files "get" "Annex: got %d file(s)") 186 | 187 | (provide 'git-annex) 188 | 189 | ;;; git-annex.el ends here 190 | --------------------------------------------------------------------------------