ol-git-link.el (9143B)
1 ;;; ol-git-link.el --- Links to specific file version 2 3 ;; Copyright (C) 2009-2014, 2021 Reimar Finken 4 5 ;; Author: Reimar Finken <reimar.finken@gmx.de> 6 ;; Keywords: files, calendar, hypermedia 7 8 ;; This file is not part of GNU Emacs. 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distaributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; `org-git-link.el' defines two new link types. The `git' link 26 ;; type is meant to be used in the typical scenario and mimics the 27 ;; `file' link syntax as closely as possible. The `gitbare' link 28 ;; type exists mostly for debugging reasons, but also allows e.g. 29 ;; linking to files in a bare git repository for the experts. 30 31 ;; * User friendy form 32 ;; [[git:/path/to/file::searchstring]] 33 34 ;; This form is the familiar from normal org file links 35 ;; including search options. However, its use is 36 ;; restricted to files in a working directory and does not 37 ;; handle bare repositories on purpose (see the bare form for 38 ;; that). 39 40 ;; The search string references a commit (a tree-ish in Git 41 ;; terminology). The two most useful types of search strings are 42 43 ;; - A symbolic ref name, usually a branch or tag name (e.g. 44 ;; master or nobelprize). 45 ;; - A ref followed by the suffix @ with a date specification 46 ;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2 47 ;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00}) 48 ;; to specify the value of the ref at a prior point in time 49 ;; 50 ;; * Bare git form 51 ;; [[gitbare:$GIT_DIR::$OBJECT]] 52 ;; 53 ;; This is the more bare metal version, which gives the user most 54 ;; control. It directly translates to the git command 55 ;; git --no-pager --git-dir=$GIT_DIR show $OBJECT 56 ;; Using this version one can also view files from a bare git 57 ;; repository. For detailed information on how to specify an 58 ;; object, see the man page of `git-rev-parse' (section 59 ;; SPECIFYING REVISIONS). A specific blob (file) can be 60 ;; specified by a suffix clolon (:) followed by a path. 61 62 ;;; Code: 63 64 (require 'org) 65 (require 'ol) 66 67 (defcustom org-git-program "git" 68 "Name of the git executable used to follow git links." 69 :type '(string) 70 :group 'org) 71 72 ;; org link functions 73 ;; bare git link 74 (org-link-set-parameters "gitbare" :follow #'org-gitbare-open) 75 76 (defun org-gitbare-open (str _) 77 (let* ((strlist (org-git-split-string str)) 78 (gitdir (nth 0 strlist)) 79 (object (nth 1 strlist))) 80 (org-git-open-file-internal gitdir object))) 81 82 83 (defun org-git-open-file-internal (gitdir object) 84 (let* ((sha (org-git-blob-sha gitdir object)) 85 (tmpdir (concat temporary-file-directory "org-git-" sha)) 86 (filename (org-git-link-filename object)) 87 (tmpfile (expand-file-name filename tmpdir))) 88 (unless (file-readable-p tmpfile) 89 (make-directory tmpdir) 90 (with-temp-file tmpfile 91 (org-git-show gitdir object (current-buffer)))) 92 (org-open-file tmpfile) 93 (set-buffer (get-file-buffer tmpfile)) 94 (setq buffer-read-only t))) 95 96 ;; user friendly link 97 (org-link-set-parameters "git" :follow #'org-git-open :store #'org-git-store-link) 98 99 (defun org-git-open (str _) 100 (let* ((strlist (org-git-split-string str)) 101 (filepath (nth 0 strlist)) 102 (commit (nth 1 strlist)) 103 (line (nth 2 strlist)) 104 (dirlist (org-git-find-gitdir (file-truename filepath))) 105 (gitdir (nth 0 dirlist)) 106 (relpath (nth 1 dirlist))) 107 (org-git-open-file-internal gitdir (concat commit ":" relpath)) 108 (when line 109 (save-restriction 110 (widen) 111 (goto-char (point-min)) 112 (forward-line (1- (string-to-number line))))))) 113 114 115 ;; Utility functions (file names etc) 116 117 (defun org-git-split-dirpath (dirpath) 118 "Given a directory name, return '(dirname basname)" 119 (let ((dirname (file-name-directory (directory-file-name dirpath))) 120 (basename (file-name-nondirectory (directory-file-name dirpath)))) 121 (list dirname basename))) 122 123 ;; finding the git directory 124 (defun org-git-find-gitdir (path) 125 "Given a file (not necessarily existing) file path, return the 126 a pair (gitdir relpath), where gitdir is the path to the first 127 .git subdirectory found updstream and relpath is the rest of 128 the path. Example: (org-git-find-gitdir 129 \"~/gitrepos/foo/bar.txt\") returns 130 '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil." 131 (let ((dir (expand-file-name (file-name-directory path))) 132 (relpath (file-name-nondirectory path))) 133 (catch 'toplevel 134 (while (not (file-exists-p (expand-file-name ".git" dir))) 135 (let ((dirlist (org-git-split-dirpath dir))) 136 (when (string= (nth 1 dirlist) "") ; at top level 137 (throw 'toplevel nil)) 138 (setq dir (nth 0 dirlist) 139 relpath (concat (file-name-as-directory (nth 1 dirlist)) relpath)))) 140 (list (expand-file-name ".git" dir) relpath)))) 141 142 143 (eval-and-compile 144 (defalias 'org-git-gitrepos-p 'org-git-find-gitdir 145 "Return non-nil if path is in git repository")) 146 147 ;; splitting the link string 148 149 ;; Both link open functions are called with a string of 150 ;; consisting of three parts separated by a double colon (::). 151 (defun org-git-split-string (str) 152 "Given a string of the form \"str1::str2::str3\", return a list of 153 three substrings \'(\"str1\" \"str2\" \"str3\"). If there are less 154 than two double colons, str2 and/or str3 may be set the empty string." 155 (let ((strlist (split-string str "::"))) 156 (cond ((= 1 (length strlist)) 157 (list (car strlist) "" "")) 158 ((= 2 (length strlist)) 159 (append strlist (list ""))) 160 ((= 3 (length strlist)) 161 strlist) 162 (t (error "org-git-split-string: only one or two :: allowed: %s" str))))) 163 164 ;; finding the file name part of a commit 165 (defun org-git-link-filename (str) 166 "Given an object description (see the man page of 167 git-rev-parse), return the nondirectory part of the referenced 168 filename, if it can be extracted. Otherwise, return a valid 169 filename." 170 (let* ((match (and (string-match "[^:]+$" str) 171 (match-string 0 str))) 172 (filename (and match (file-name-nondirectory match)))) ;extract the final part without slash 173 filename)) 174 175 ;; creating a link 176 (defun org-git-create-searchstring (branch timestring) 177 (concat branch "@{" timestring "}")) 178 179 180 (defun org-git-create-git-link (file &optional line) 181 "Create git link part to file at specific time" 182 (interactive "FFile: ") 183 (let* ((gitdir (nth 0 (org-git-find-gitdir (file-truename file)))) 184 (branchname (org-git-get-current-branch gitdir)) 185 (timestring (format-time-string "%Y-%m-%d" (current-time)))) 186 (concat "git:" file "::" (org-git-create-searchstring branchname timestring) 187 (if line (format "::%s" line) "")))) 188 189 (defun org-git-store-link () 190 "Store git link to current file." 191 (when (buffer-file-name) 192 (let ((file (abbreviate-file-name (buffer-file-name))) 193 (line (line-number-at-pos))) 194 (when (org-git-gitrepos-p file) 195 (org-store-link-props 196 :type "git" 197 :link (org-git-create-git-link file line)))))) 198 199 (defun org-git-insert-link-interactively (file searchstring &optional description) 200 (interactive "FFile: \nsSearch string: \nsDescription: ") 201 (insert (org-make-link-string (concat "git:" file "::" searchstring) description))) 202 203 ;; Calling git 204 (defun org-git-show (gitdir object buffer) 205 "Show the output of git --git-dir=gitdir show object in buffer." 206 (unless 207 (zerop (call-process org-git-program nil buffer nil 208 "--no-pager" (concat "--git-dir=" gitdir) "show" object)) 209 (error "git error: %s " (with-current-buffer buffer (buffer-string))))) 210 211 (defun org-git-blob-sha (gitdir object) 212 "Return sha of the referenced object" 213 (with-temp-buffer 214 (if (zerop (call-process org-git-program nil t nil 215 "--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object)) 216 (buffer-substring (point-min) (1- (point-max))) ; to strip off final newline 217 (error "git error: %s " (buffer-string))))) 218 219 (defun org-git-get-current-branch (gitdir) 220 "Return the name of the current branch." 221 (with-temp-buffer 222 (if (not (zerop (call-process org-git-program nil t nil 223 "--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD"))) 224 (error "git error: %s " (buffer-string)) 225 (goto-char (point-min)) 226 (if (looking-at "^refs/heads/") ; 11 characters 227 (buffer-substring 12 (1- (point-max))))))) ; to strip off final newline 228 229 (provide 'ol-git-link) 230 231 ;;; ol-git-link.el ends here