summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfpi2020-07-22 10:32:03 +0200
committerfpi2020-07-22 10:39:07 +0200
commitad75caf16749bf2435ffa7a12661059f133cfad2 (patch)
treeba1e76a2cb044bc708f15608eeed76229d579c30
parentMake time-budgets display fancier (diff)
Add git annex support
Mostly copied from https://github.com/mm--/dot-emacs/blob/master/jmm-emacs.org
Diffstat (limited to '')
-rw-r--r--emacs-init.org334
1 files changed, 333 insertions, 1 deletions
diff --git a/emacs-init.org b/emacs-init.org
index 7eee49c..660e3be 100644
--- a/emacs-init.org
+++ b/emacs-init.org
@@ -1946,7 +1946,10 @@ confines of word boundaries (e.g. multiple words)."
:hook
(dired-mode . dired-hide-details-mode)
(dired-mode . hl-line-mode)
- (dired-mode . auto-revert-mode))
+ (dired-mode . auto-revert-mode)
+ :bind (:map dired-mode-map
+ <<dired-bindings>>
+ ))
(use-package find-dired
:after dired
@@ -2074,6 +2077,335 @@ of src_shell{getconf "PATH"}. See [[elisp:(describe-variable
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))
#+end_src
** Git
+*** Git annex
+There are some great ressources on [[https://git-annex.branchable.com/][git-annex]] integration in emacs in [[https://github.com/mm--/dot-emacs/blob/master/jmm-emacs.org][Josh's config]]. Most of my configuration is copied from there.
+#+begin_src emacs-lisp
+(use-package git-annex
+ :straight t
+ :config
+ <<git-annex-config>>
+ :bind
+ (:map git-annex-dired-map
+ <<git-annex-dired-bindings>>)
+ :after (dired))
+#+end_src
+**** Actions to lock/unlock files
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("l" . git-annex-dired-lock-files)
+("u" . git-annex-dired-unlock-files)
+#+end_src
+=git-annex.el= defines a handy macro to define generic =git-annex= CLI calls.
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-config
+(git-annex-dired-do-to-files "lock" "Annex: locked %d file(s)")
+(git-annex-dired-do-to-files "unlock" "Annex: unlocked %d file(s)")
+#+end_src
+**** Fix faces
+=git-annex.el= kinda clobbers ~dired-marked-face~ and ~dired-flagged-face~. This fixes that.
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-config
+(progn
+ (add-to-list 'dired-font-lock-keywords
+ (list "^[*].+ -> .*\\.git/annex/"
+ '("\\(.+\\)\\( -> .+\\)" (dired-move-to-filename) nil
+ (1 dired-marked-face)
+ (2 git-annex-dired-annexed-invisible))))
+ (add-to-list 'dired-font-lock-keywords
+ (list "^[D].+ -> .*\\.git/annex/"
+ '("\\(.+\\)\\( -> .+\\)" (dired-move-to-filename) nil
+ (1 dired-flagged-face)
+ (2 git-annex-dired-annexed-invisible)))))
+#+end_src
+**** Make it easy to add metadata tags in git-annex
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("t" . jmm/dired-git-annex-tag)
+#+end_src
+Git-annex has a pretty cool ability to tag files and filter directory views based on metadata. It's kind of a pain to tag files, though, so here's a function that adds some autocompletion to tagging files.
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+(defvar-local jmm/git-annex-directory-tags nil
+ "Current git-annex tags set in the directory, as a list.")
+
+(defun jmm/dired-git-annex-current-tags (file-list &optional intersection)
+ "Get current git-annex tag for each file in FILE-LIST. With
+ optional argument INTERSECTION, only show tags all files share in common."
+ (let* ((metadata (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (apply #'process-file "git" nil t nil "annex" "metadata" "--json" file-list))))
+ (json-array-type 'list)
+ (jsonout (-map 'json-read-from-string (split-string metadata "\n" t))))
+ (-reduce (if intersection '-intersection '-union) (--map (cdr (assoc 'tag (cdr (assoc 'fields it)))) jsonout))))
+
+(defun jmm/dired-git-annex-tag (file-list tags &optional arg)
+ "Add git-annex TAGS to each file in FILE-LIST.
+Used as an interactive command, prompt for a list of tags for all
+files, showing the current tags all files currently have in common."
+ (interactive
+ (let* ((files (dired-get-marked-files t current-prefix-arg))
+ (shared-tags (jmm/dired-git-annex-current-tags files t))
+ ;; Cache directory tags
+ (current-tags (or jmm/git-annex-directory-tags
+ (setq jmm/git-annex-directory-tags
+ (or (jmm/dired-git-annex-current-tags '("--all")) '("")))))
+ (crm-separator " ")
+ (crm-local-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map crm-local-completion-map)
+ (define-key map " " 'self-insert-command)
+ map))
+ (tags (completing-read-multiple
+ "Tags: " (--map (concat it crm-separator) current-tags)
+ nil nil
+ (when shared-tags (mapconcat 'identity shared-tags " ")))))
+ (setq jmm/git-annex-directory-tags (-union tags jmm/git-annex-directory-tags))
+ (list files tags current-prefix-arg)))
+ (let ((args (cl-loop for x in tags
+ append (list "-t" x))))
+ (-each file-list
+ (lambda (file)
+ (apply #'call-process "git" nil nil nil "annex" "metadata" (append args (list file)))))
+ (message (format "Tagged %d file(s)" (length file-list)))))
+#+END_SRC
+**** Mark unavailable files
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("*")
+("* a" . jmm/dired-mark-git-annex-available-files)
+("* u" . jmm/dired-mark-git-annex-unavailable-files)
+#+end_src
+
+When you use this in combination with ~dired-do-kill-lines~ (by default bound to ~k~), it's easy to hide files that aren't present in the current annex repository.
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+(defun jmm/dired-mark-git-annex-unavailable-files ()
+ "Mark git-annex files that are not present."
+ (interactive)
+ (dired-mark-if
+ (and (looking-at-p ".* -> \\(.*\\.git/annex/.+\\)")
+ (not (file-exists-p (file-truename (dired-get-filename t)))))
+ "unavailable file"))
+
+(defun jmm/dired-mark-git-annex-available-files ()
+ "Mark git-annex files that are present."
+ (interactive)
+ (dired-mark-if
+ (and (looking-at-p ".* -> \\(.*\\.git/annex/.+\\)")
+ (file-exists-p (file-truename (dired-get-filename t))))
+ "available file"))
+#+END_SRC
+**** Mark git-annex files with git-annex-matching-options
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref dired-bindings
+("% a" . jmm/dired-mark-files-git-annex-matching)
+#+END_SRC
+
+This command makes it easy to mark dired files using ~git-annex-matching-options~.
+
+For instance, you could find files that are in a certain remote using ~--in=remote~ or mark/unmark files that have a certain tag using ~--metadata tag=sometag~.
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+(defun jmm/dired-mark-files-git-annex-matching (matchingoptions &optional marker-char)
+ "Mark all files that match git annex's MATCHINGOPTIONS for use in later commands.
+A prefix argument means to unmark them instead.
+`.' and `..' are never marked."
+ (interactive
+ (list (read-string (concat (if current-prefix-arg "Unmark" "Mark")
+ " files matching (git annex match expression): ")
+ nil 'jmm-dired-annex-matchingoptions-history)
+ (if current-prefix-arg ?\040)))
+ (let ((dired-marker-char (or marker-char dired-marker-char)))
+ (dired-mark-if
+ (and (not (looking-at-p dired-re-dot))
+ (not (eolp)) ; empty line
+ (let ((fn (dired-get-filename nil t)))
+ (when (and fn (not (file-directory-p fn)))
+ (message "Checking %s" fn)
+ (s-present? (shell-command-to-string
+ (mapconcat
+ #'identity
+ (list "git annex find" matchingoptions (shell-quote-argument fn))
+ " "))))))
+ "matching file")))
+#+END_SRC
+**** Real file size
+:PROPERTIES:
+:header-args:emacs-lisp: :tangle no
+:END:
+Dired by default only shows the symlink file size. While it can be told to dereference symbolic links with the =-L= flag this only works on annexed files if they are present on the current machine.
+Settings this flag causes more problems than it solves. Instead Josh has derived the functions below to determine the file size. I do not use them for now, but copied them here for future reference/usage.
+***** Get git-annex file sizes
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("s" . jmm/dired-git-annex-print-human-file-size)
+#+end_src
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+(defun jmm/git-annex-file-target (filename)
+ "If FILENAME is a git annex file, return its symlink target."
+ (-when-let (symname (and filename
+ (file-symlink-p filename)))
+ (when (string-match-p ".*\\.git/annex/.+" symname)
+ symname)))
+
+(defun jmm/dired-git-annex-file-target ()
+ "If the dired file at point is a git annex file, return its symlink target."
+ (jmm/git-annex-file-target (dired-get-filename nil t)))
+
+(defun jmm/git-annex-file-size (filename)
+ "Try to determine the size of the git annex file FILENAME."
+ (-when-let (target (jmm/git-annex-file-target filename))
+ (or (save-match-data
+ (when (string-match "SHA256E-s\\([0-9]+\\)--" target)
+ (string-to-number (match-string 1 target))))
+ (-some-> (expand-file-name target (file-name-directory filename))
+ file-attributes
+ file-attribute-size))))
+
+(defun jmm/dired-git-annex-print-human-file-size ()
+ "Try to print the human readable file size of the dired git-annex file at point."
+ (interactive)
+ (let* ((filename (dired-get-filename nil t))
+ (string-file (file-name-nondirectory filename)))
+ (-if-let (filesize (-some-> (jmm/git-annex-file-size filename)
+ file-size-human-readable))
+ (message "%s - %s" filesize string-file)
+ (message "Can't determine git annex file size of %s" string-file))))
+#+END_SRC
+***** Show git-annex file sizes in dired
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("S" . jmm/dired-git-annex-add-real-file-sizes)
+#+end_src
+
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+;; Based off of `dired--align-all-files'
+(defun jmm/dired-git-annex-add-real-file-sizes ()
+ "Go through all the git-annex files in dired, replace the
+symlink file size with the real file size, then try to align
+everything."
+ (interactive)
+ (require 'dired-aux)
+ (let ((regexp directory-listing-before-filename-regexp))
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (while (or (dired-move-to-filename)
+ (progn (save-restriction
+ (narrow-to-region (dired-subdir-min) (dired-subdir-max))
+ (dired--align-all-files))
+ (dired-next-subdir 1 t)
+ (dired-goto-next-file)
+ (dired-move-to-filename)))
+ (let ((inhibit-read-only t))
+ (when (and (jmm/dired-git-annex-file-target)
+ (re-search-backward regexp (line-beginning-position) t))
+ (goto-char (match-beginning 0))
+ (-when-let (newsize (-some-> (jmm/git-annex-file-size (dired-get-filename nil t))
+ file-size-human-readable))
+ (search-backward-regexp "[[:space:]]" nil t)
+ (when (re-search-forward "[[:space:]]+\\([^[:space:]]+\\)[[:space:]]" nil t)
+ (goto-char (match-beginning 1))
+ (delete-region (point) (match-end 1))
+ (insert-and-inherit newsize))))
+ (forward-line))))))
+#+END_SRC
+
+#+BEGIN_SRC emacs-lisp :tangle no
+;; (add-hook 'dired-mode-hook #'jmm/dired-git-annex-add-real-file-sizes)
+;; (add-hook 'dired-after-readin-hook #'jmm/dired-git-annex-add-real-file-sizes)
+#+END_SRC
+***** Sort dired by file size
+#+BEGIN_SRC emacs-lisp :tangle no :noweb-ref git-annex-config
+(defun jmm/dired-dir-files-beginning ()
+ "First point where there's a filename on the line. Beginning of line."
+ (save-excursion
+ (goto-char (dired-subdir-min))
+ (dired-goto-next-file)
+ (beginning-of-line)
+ (point)))
+
+(defun jmm/dired-dir-files-end ()
+ "Last point where there's a filename. End of line."
+ (save-excursion
+ (goto-char (dired-subdir-max))
+ (while (not (dired-get-filename nil t))
+ (dired-previous-line nil))
+ (end-of-line)
+ (point)))
+
+(defun jmm/dired-file-size ()
+ "Return the file size of a file at point (for sorting). Takes
+into account git-annex files."
+ (let* ((filename (dired-get-filename nil t))
+ (string-file (file-name-nondirectory filename)))
+ (or (jmm/git-annex-file-size filename)
+ (file-attribute-size (file-attributes filename)))))
+
+;; TODO: Should just try to directly use the field listed.
+(defun jmm/dired-sort-size (&optional ascending)
+ "Sort some dired lines by size (consider annex sizes).
+With optional argument ASCENDING, sort by ascending file size. (I
+like going the other way around usually.)"
+ (interactive "P")
+ (let (buffer-read-only
+ (beg (jmm/dired-dir-files-beginning))
+ (end (jmm/dired-dir-files-end)))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (sort-subr (not ascending)
+ 'forward-line 'end-of-line
+ #'jmm/dired-file-size nil)))))
+#+END_SRC
+**** Browsing URLs for git-annex files
+#+begin_src emacs-lisp :tangle no :noweb-ref git-annex-dired-bindings
+("b" . jmm/git-annex-browse-url)
+#+end_src
+#+BEGIN_SRC emacs-lisp
+;; TODO: Process multiple files at once?
+(defun jmm/git-annex-whereis-info (filename)
+ "Get information about where a git-annex file exists.
+Returns a parsed json list from whereis."
+ (let* ((json-array-type 'list)
+ (whereisdata (shell-command-to-string
+ (mapconcat
+ #'identity
+ (list "git annex whereis --json" (shell-quote-argument filename))
+ " "))))
+ (when (s-present? whereisdata)
+ (json-read-from-string whereisdata))))
+
+(defun jmm/git-annex-urls (filename)
+ "Get the git-annex web urls for FILENAME."
+ (-some->> (jmm/git-annex-whereis-info filename)
+ (assoc-default 'whereis)
+ (-mapcat (lambda (x) (assoc-default 'urls x)))
+ (-map (lambda (s) (s-chop-prefix "yt:" s)))))
+
+(defun jmm/git-annex-browse-url ()
+ "Browse the first git-annex web urls for file at point."
+ (interactive)
+ (let* ((filename (dired-get-filename nil t))
+ (filestr (file-name-nondirectory filename)))
+ (-if-let (url (car (jmm/git-annex-urls filename)))
+ (progn
+ (message "Opening url: %s" url)
+ (jmm/org-open-link-alternate-browser #'browse-url url))
+ (user-error "No url found for %s" filestr))))
+#+END_SRC
+**** Eshell helper functions
+Helper functions to open dired view from eshell or list =git-annex= files which match a search.
+#+BEGIN_SRC emacs-lisp
+(defun jmm/git-annex-find-files (&rest args)
+ "Generate a list of git annex files that match ARGS.
+For example, ARGS could be \"--in=here\""
+ (-remove #'s-blank?
+ (s-split "\0"
+ (shell-command-to-string (mapconcat #'identity
+ (append '("git annex find --print0") args)
+ " ")))))
+(defun eshell/dga (&rest args)
+ "Show a `dired' buffer of git annex files that match ARGS.
+For example, ARGS could be \"--in=here\""
+ (dired (cons "." (apply #'jmm/git-annex-find-files args))))
+
+(defun eshell/gaf (&rest args)
+ "Return a list of git annex files that match ARGS.
+For example, ARGS could be \"--in=here\""
+ (apply #'jmm/git-annex-find-files args))
+#+END_SRC
*** Magit
#+BEGIN_SRC emacs-lisp
(use-package magit