Add 'inline-only option to org-export-babel-evaluate
[org-mode/org-tableheadings.git] / contrib / lisp / org-git-link.el
blobb9e6a4e42eb8ac066266c6eb043fede8f40f4169
1 ;;; org-git-link.el --- Provide org links to specific file version
3 ;; Copyright (C) 2009-2013 Reimar Finken
5 ;; Author: Reimar Finken <reimar.finken@gmx.de>
6 ;; Keywords: files, calendar, hypermedia
8 ;; This file is not part of GNU Emacs.
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.
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.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
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.
31 ;; * User friendy form
32 ;; [[git:/path/to/file::searchstring]]
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).
40 ;; The search string references a commit (a tree-ish in Git
41 ;; terminology). The two most useful types of search strings are
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
50 ;; * Bare git form
51 ;; [[gitbare:$GIT_DIR::$OBJECT]]
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.
62 ;;; Code:
64 (require 'org)
65 (defcustom org-git-program "git"
66 "Name of the git executable used to follow git links."
67 :type '(string)
68 :group 'org)
70 ;; org link functions
71 ;; bare git link
72 (org-add-link-type "gitbare" 'org-gitbare-open)
74 (defun org-gitbare-open (str)
75 (let* ((strlist (org-git-split-string str))
76 (gitdir (first strlist))
77 (object (second strlist)))
78 (org-git-open-file-internal gitdir object)))
81 (defun org-git-open-file-internal (gitdir object)
82 (let* ((sha (org-git-blob-sha gitdir object))
83 (tmpdir (concat temporary-file-directory "org-git-" sha))
84 (filename (org-git-link-filename object))
85 (tmpfile (expand-file-name filename tmpdir)))
86 (unless (file-readable-p tmpfile)
87 (make-directory tmpdir)
88 (with-temp-file tmpfile
89 (org-git-show gitdir object (current-buffer))))
90 (org-open-file tmpfile)
91 (set-buffer (get-file-buffer tmpfile))
92 (setq buffer-read-only t)))
94 ;; user friendly link
95 (org-add-link-type "git" 'org-git-open)
97 (defun org-git-open (str)
98 (let* ((strlist (org-git-split-string str))
99 (filepath (first strlist))
100 (commit (second strlist))
101 (dirlist (org-git-find-gitdir (file-truename filepath)))
102 (gitdir (first dirlist))
103 (relpath (second dirlist)))
104 (org-git-open-file-internal gitdir (concat commit ":" relpath))))
107 ;; Utility functions (file names etc)
109 (defun org-git-split-dirpath (dirpath)
110 "Given a directory name, return '(dirname basname)"
111 (let ((dirname (file-name-directory (directory-file-name dirpath)))
112 (basename (file-name-nondirectory (directory-file-name dirpath))))
113 (list dirname basename)))
115 ;; finding the git directory
116 (defun org-git-find-gitdir (path)
117 "Given a file (not necessarily existing) file path, return the
118 a pair (gitdir relpath), where gitdir is the path to the first
119 .git subdirectory found updstream and relpath is the rest of
120 the path. Example: (org-git-find-gitdir
121 \"~/gitrepos/foo/bar.txt\") returns
122 '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil."
123 (let ((dir (file-name-directory path))
124 (relpath (file-name-nondirectory path)))
125 (catch 'toplevel
126 (while (not (file-exists-p (expand-file-name ".git" dir)))
127 (let ((dirlist (org-git-split-dirpath dir)))
128 (when (string= (second dirlist) "") ; at top level
129 (throw 'toplevel nil))
130 (setq dir (first dirlist)
131 relpath (concat (file-name-as-directory (second dirlist)) relpath))))
132 (list (expand-file-name ".git" dir) relpath))))
135 (eval-and-compile
136 (if (featurep 'xemacs)
137 (defalias 'org-git-gitrepos-p 'org-git-find-gitdir)
138 (defalias 'org-git-gitrepos-p 'org-git-find-gitdir
139 "Return non-nil if path is in git repository")))
141 ;; splitting the link string
143 ;; Both link open functions are called with a string of
144 ;; consisting of two parts separated by a double colon (::).
145 (defun org-git-split-string (str)
146 "Given a string of the form \"str1::str2\", return a list of
147 two substrings \'(\"str1\" \"str2\"). If the double colon is mising, take str2 to be the empty string."
148 (let ((strlist (split-string str "::")))
149 (cond ((= 1 (length strlist))
150 (list (car strlist) ""))
151 ((= 2 (length strlist))
152 strlist)
153 (t (error "org-git-split-string: only one :: allowed: %s" str)))))
155 ;; finding the file name part of a commit
156 (defun org-git-link-filename (str)
157 "Given an object description (see the man page of
158 git-rev-parse), return the nondirectory part of the referenced
159 filename, if it can be extracted. Otherwise, return a valid
160 filename."
161 (let* ((match (and (string-match "[^:]+$" str)
162 (match-string 0 str)))
163 (filename (and match (file-name-nondirectory match)))) ;extract the final part without slash
164 filename))
166 ;; creating a link
167 (defun org-git-create-searchstring (branch timestring)
168 (concat branch "@{" timestring "}"))
171 (defun org-git-create-git-link (file)
172 "Create git link part to file at specific time"
173 (interactive "FFile: ")
174 (let* ((gitdir (first (org-git-find-gitdir (file-truename file))))
175 (branchname (org-git-get-current-branch gitdir))
176 (timestring (format-time-string "%Y-%m-%d" (current-time))))
177 (concat "git:" file "::" (org-git-create-searchstring branchname timestring))))
179 (defun org-git-store-link ()
180 "Store git link to current file."
181 (when (buffer-file-name)
182 (let ((file (abbreviate-file-name (buffer-file-name))))
183 (when (org-git-gitrepos-p file)
184 (org-store-link-props
185 :type "git"
186 :link (org-git-create-git-link file))))))
188 (add-hook 'org-store-link-functions 'org-git-store-link)
190 (defun org-git-insert-link-interactively (file searchstring &optional description)
191 (interactive "FFile: \nsSearch string: \nsDescription: ")
192 (insert (org-make-link-string (concat "git:" file "::" searchstring) description)))
194 ;; Calling git
195 (defun org-git-show (gitdir object buffer)
196 "Show the output of git --git-dir=gitdir show object in buffer."
197 (unless
198 (zerop (call-process org-git-program nil buffer nil
199 "--no-pager" (concat "--git-dir=" gitdir) "show" object))
200 (error "git error: %s " (with-current-buffer buffer (buffer-string)))))
202 (defun org-git-blob-sha (gitdir object)
203 "Return sha of the referenced object"
204 (with-temp-buffer
205 (if (zerop (call-process org-git-program nil t nil
206 "--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object))
207 (buffer-substring (point-min) (1- (point-max))) ; to strip off final newline
208 (error "git error: %s " (buffer-string)))))
210 (defun org-git-get-current-branch (gitdir)
211 "Return the name of the current branch."
212 (with-temp-buffer
213 (if (not (zerop (call-process org-git-program nil t nil
214 "--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD")))
215 (error "git error: %s " (buffer-string))
216 (goto-char (point-min))
217 (if (looking-at "^refs/heads/") ; 11 characters
218 (buffer-substring 12 (1- (point-max))))))) ; to strip off final newline
220 (provide 'org-git-link)
222 ;;; org-git-link.el ends here