ol-git-link.el 8.9 KB

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