Document planner-report.el.
[planner-el.git] / planner-xtla.el
blob9d59ebbc658dfb45c6fb7dc76941381a4a557f7f
1 ;;; planner-xtla.el --- Xtla integration for the Emacs Planner
3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
4 ;; Parts copyright (C) 2005 Yann Hodique (hodique AT lifl DOT fr)
6 ;; Author: Stefan Reichör <stefan@xsteve.at>
7 ;; Keywords: planner, xtla
9 ;; This file is part of Planner. It is not part of GNU Emacs.
11 ;; Planner is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; Planner is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with Planner; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
26 ;;;_ + Commentary:
28 ;; This file allows you to refer to your tla changesets easily from within
29 ;; a planner page.
31 ;; Example:
32 ;; [[xtla://miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-19][patch-19]]
33 ;; can be browsed easily via xtla
35 ;;; Contributors:
37 ;; Yann Hodique helped port this to Muse.
39 ;;; Code:
41 (require 'planner)
42 (require 'xtla)
44 (defgroup planner-xtla nil
45 "Planner options for the xtla integration."
46 :prefix "planner-xtla-"
47 :group 'planner)
49 (defcustom planner-xtla-log-edit-include-files-flag
51 "Non-nil means include a list of committed files in the note."
52 :type 'boolean
53 :group 'planner-xtla)
55 (defcustom planner-xtla-log-edit-notice-commit-function nil
56 "Function that should return non-nil if this commit should be noted.
57 The function will be run in the log buffer."
58 :type '(choice
59 (const :tag "Always note commits" t)
60 function)
61 :group 'planner-xtla)
63 (defcustom planner-xtla-url-transform-alist nil
64 "List of associations between a branch name with a base
65 url. For example : '(\"hodique@lifl.fr--2005\" .
66 \"http://www.lifl.fr/~hodique/archives/2005\"). This overrides the
67 url given by `tla--archive-tree'. Useful when using a mirror."
68 :type '(repeat (cons string string))
69 :group 'planner-xtla)
71 ;;;###autoload
72 (defun planner-annotation-from-xtla ()
73 "If called from a xtla buffer, return an annotation.
74 Suitable for use in `planner-annotation-functions'."
75 (cond ((eq major-mode 'tla-revision-list-mode)
76 (planner-make-link (concat "xtla://"
77 (cadr (tla--get-revision-info-at-point)))
78 (cadr (tla--get-revision-info-at-point))))))
80 ;;;###autoload
81 (defun planner-xtla-browse-url (url)
82 "If this is a xtla url, handle it."
83 (when (string-match "\\`xtla:/?/?\\(.+\\)" url)
84 (tla-get-changeset (match-string 1 url) t)
85 t))
87 ;;;###autoload
88 (defun planner-xtla-log-edit-add-note ()
89 "Provide `planner-log-edit'-like functionality for xtla.
90 This function is automatically called by `tla-commit-hook'.
91 See also `planner-xtla-log-edit-notice-commit-function'."
92 (interactive)
93 (when (if (functionp planner-xtla-log-edit-notice-commit-function)
94 (funcall planner-xtla-log-edit-notice-commit-function)
95 planner-xtla-log-edit-notice-commit-function)
96 (let ((arch-revision)
97 (planner-xtla-link)
98 (committed-files))
99 ;; assume we are in the *tla-buffer* after the commit
100 (goto-char (point-min))
101 (re-search-forward "^\\* committed ")
102 (setq arch-revision (buffer-substring-no-properties
103 (point) (planner-line-end-position)))
104 (setq committed-files (buffer-substring-no-properties
105 (point-min) (planner-line-beginning-position)))
106 (setq planner-xtla-link (planner-make-link
107 (concat "xtla://" arch-revision) arch-revision))
108 (save-window-excursion
109 (planner-create-note nil)
110 (insert "Commit")
111 (insert (concat " " planner-xtla-link))
112 (newline)
113 (when planner-xtla-log-edit-include-files-flag
114 (insert "Files:\n")
115 (insert committed-files)
116 (newline))
117 (insert (replace-regexp-in-string "^\\*" " *"
118 tla-last-commit-message))))))
120 (defun planner-xtla-url-transform (target &rest ignored)
121 "Transforms a xtla link into a http link to a public
122 location. The association is first searched in
123 `planner-xtla-url-transform-alist', and then in
124 `tla--archive-tree'"
125 (tla--archive-tree-build-archives t)
126 (let ((reg (concat "\\`xtla:/?/?\\(\\(?:"
127 (mapconcat 'car tla--archive-tree "\\|")
128 "\\)/\\(?:.*\\)\\)$")))
129 (save-match-data
130 (if (string-match reg target)
131 (let* ((elts (tla--name-split (match-string 1 target)))
132 (subst (or (cdr (assoc (car elts)
133 planner-xtla-url-transform-alist))
134 (car (cadr (assoc (car elts)
135 tla--archive-tree))))))
136 (when (nth 1 elts)
137 (setq subst (concat subst "/" (nth 1 elts)))
138 (when (nth 2 elts)
139 (setq subst (concat subst "/" (nth 1 elts) "--" (nth 2 elts)))
140 (when (nth 3 elts)
141 (setq subst (concat subst "/" (nth 1 elts) "--" (nth 2 elts)
142 "--" (nth 3 elts)))
143 (when (nth 4 elts)
144 (setq subst (concat subst "/" (nth 4 elts))))))))
145 target))))
147 (add-to-list 'muse-publish-url-transforms 'planner-xtla-url-transform)
149 (add-hook 'tla-commit-done-hook 'planner-xtla-log-edit-add-note)
151 (planner-add-protocol "xtla:/?/?" 'planner-xtla-browse-url
152 'planner-xtla-url-transform)
153 (add-hook 'planner-annotation-functions 'planner-annotation-from-xtla)
154 (custom-add-option 'planner-annotation-functions 'planner-annotation-from-xtla)
156 (provide 'planner-xtla)
158 ;;; planner-xtla.el ends here