;;; 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 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)))
(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