|
|
@@ -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
|
Carsten Dominik