summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarsten Dominik <carsten.dominik@gmail.com>2009-10-28 12:14:41 +0100
committerCarsten Dominik <carsten.dominik@gmail.com>2009-10-28 12:14:41 +0100
commit848b2039a1257bc497a3366a35542f79942a0281 (patch)
tree6e3541084b549f514ffe086932b0eeec8d665f1f
parentcaea94a408ddc095365a727883dd9bc103e1edd5 (diff)
downloadorg-mode-848b2039a1257bc497a3366a35542f79942a0281.tar.gz
Add org-git-link.el by Raimar Finken
-rw-r--r--contrib/README1
-rw-r--r--contrib/lisp/org-git-link.el217
-rw-r--r--lisp/org.el1
3 files changed, 219 insertions, 0 deletions
diff --git a/contrib/README b/contrib/README
index c65fde8..6555bf4 100644
--- a/contrib/README
+++ b/contrib/README
@@ -24,6 +24,7 @@ org-eval-light.el --- Evaluate in-buffer code on demand
org-expiry.el --- Expiry mechanism for Org entries
org-exp-bibtex.el --- Export citations to LaTeX and HTML
org-export-generic.el --- Export framework for configurable backends
+org-git-link.el --- Provide org links to specific file version
org-interactive-query.el --- Interactive modification of tags query
org-invoice.el --- Help manage client invoices in OrgMode
org-jira.el --- Add a jira:ticket protocol to Org
diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el
new file mode 100644
index 0000000..1206ace
--- /dev/null
+++ b/contrib/lisp/org-git-link.el
@@ -0,0 +1,217 @@
+;;; 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))))
+
+
+(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."
+ (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
diff --git a/lisp/org.el b/lisp/org.el
index 2a227b9..f13b21d 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -219,6 +219,7 @@ to add the symbol `xyz', and the package must have a call to
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
(const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
(const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
+ (const :tag "C git-link: Provide org links to specific file version" org-git-link)
(const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
(const :tag "C invoice Help manage client invoices in Org-mode" org-invoice)