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