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 free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; This file is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02110-1301, USA.
26 ;; This file allows you to refer to your tla changesets easily from within
30 ;; [[xtla://miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-19][patch-19]]
31 ;; can be browsed easily via xtla
35 ;; Yann Hodique helped port this to Muse.
42 (defgroup planner-xtla nil
43 "Planner options for the xtla integration."
44 :prefix
"planner-xtla-"
47 (defcustom planner-xtla-log-edit-include-files-flag
49 "Non-nil means include a list of committed files in the note."
53 (defcustom planner-xtla-log-edit-notice-commit-function nil
54 "Function that should return non-nil if this commit should be noted.
55 The function will be run in the log buffer."
57 (const :tag
"Always note commits" t
)
61 (defcustom planner-xtla-url-transform-alist nil
62 "List of associations between a branch name with a base
63 url. For example : '(\"hodique@lifl.fr--2005\" .
64 \"http://www.lifl.fr/~hodique/archives/2005\"). This overrides the
65 url given by `tla--archive-tree'. Useful when using a mirror."
66 :type
'(repeat (cons string string
))
70 (defun planner-annotation-from-xtla ()
71 "If called from a xtla buffer, return an annotation.
72 Suitable for use in `planner-annotation-functions'."
73 (cond ((eq major-mode
'tla-revision-list-mode
)
74 (planner-make-link (concat "xtla://"
75 (cadr (tla--get-revision-info-at-point)))
76 (cadr (tla--get-revision-info-at-point))))))
79 (defun planner-xtla-browse-url (url)
80 "If this is a xtla url, handle it."
81 (when (string-match "\\`xtla:/?/?\\(.+\\)" url
)
82 (tla-get-changeset (match-string 1 url
) t
)
86 (defun planner-xtla-log-edit-add-note ()
87 "Provide `planner-log-edit'-like functionality for xtla.
88 This function is automatically called by `tla-commit-hook'.
89 See also `planner-xtla-log-edit-notice-commit-function'."
91 (when (if (functionp planner-xtla-log-edit-notice-commit-function
)
92 (funcall planner-xtla-log-edit-notice-commit-function
)
93 planner-xtla-log-edit-notice-commit-function
)
97 ;; assume we are in the *tla-buffer* after the commit
98 (goto-char (point-min))
99 (re-search-forward "^\\* committed ")
100 (setq arch-revision
(buffer-substring-no-properties
101 (point) (planner-line-end-position)))
102 (setq committed-files
(buffer-substring-no-properties
103 (point-min) (planner-line-beginning-position)))
104 (setq planner-xtla-link
(planner-make-link
105 (concat "xtla://" arch-revision
) arch-revision
))
106 (save-window-excursion
107 (planner-create-note nil
)
109 (insert (concat " " planner-xtla-link
))
111 (when planner-xtla-log-edit-include-files-flag
113 (insert committed-files
)
115 (insert (replace-regexp-in-string "^\\*" " *"
116 tla-last-commit-message
))))))
118 (defun planner-xtla-url-transform (target &rest ignored
)
119 "Transforms a xtla link into a http link to a public
120 location. The association is first searched in
121 `planner-xtla-url-transform-alist', and then in
123 (tla--archive-tree-build-archives t
)
124 (let ((reg (concat "\\`xtla:/?/?\\(\\(?:"
125 (mapconcat 'car tla--archive-tree
"\\|")
126 "\\)/\\(?:.*\\)\\)$")))
128 (if (string-match reg target
)
129 (let* ((elts (tla--name-split (match-string 1 target
)))
130 (subst (or (cdr (assoc (car elts
)
131 planner-xtla-url-transform-alist
))
132 (car (cadr (assoc (car elts
)
133 tla--archive-tree
))))))
135 (setq subst
(concat subst
"/" (nth 1 elts
)))
137 (setq subst
(concat subst
"/" (nth 1 elts
) "--" (nth 2 elts
)))
139 (setq subst
(concat subst
"/" (nth 1 elts
) "--" (nth 2 elts
)
142 (setq subst
(concat subst
"/" (nth 4 elts
))))))))
145 (add-to-list 'muse-publish-url-transforms
'planner-xtla-url-transform
)
147 (add-hook 'tla-commit-done-hook
'planner-xtla-log-edit-add-note
)
149 (planner-add-protocol "xtla:/?/?" 'planner-xtla-browse-url
150 'planner-xtla-url-transform
)
151 (add-hook 'planner-annotation-functions
'planner-annotation-from-xtla
)
152 (custom-add-option 'planner-annotation-functions
'planner-annotation-from-xtla
)
154 (provide 'planner-xtla
)
156 ;;; planner-xtla.el ends here