planner-xtla.el

   1 ;;; planner-xtla.el --- Xtla integration for the Emacs Planner
   2
   3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
   4 ;; Parts copyright (C) 2005 Yann Hodique (hodique AT lifl DOT fr)
   5
   6 ;; Author: Stefan Reichör <stefan@xsteve.at>
   7 ;; Keywords: planner, xtla
   8
   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)
  12 ;; any later version.
  13
  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.
  18
  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.
  23
  24 ;;;_ + Commentary:
  25
  26 ;; This file allows you to refer to your tla changesets easily from within
  27 ;; a planner page.
  28 ;;
  29 ;; Example:
  30 ;; [[xtla://miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-19][patch-19]]
  31 ;;   can be browsed easily via xtla
  32
  33 ;;; Contributors:
  34
  35 ;; Yann Hodique helped port this to Muse.
  36
  37 ;;; Code:
  38
  39 (require 'planner)
  40 (require 'xtla)
  41
  42 (defgroup planner-xtla nil
  43   "Planner options for the xtla integration."
  44   :prefix "planner-xtla-"
  45   :group 'planner)
  46
  47 (defcustom planner-xtla-log-edit-include-files-flag
  48   t
  49   "Non-nil means include a list of committed files in the note."
  50   :type 'boolean
  51   :group 'planner-xtla)
  52
  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."
  56   :type '(choice
  57           (const :tag "Always note commits" t)
  58           function)
  59   :group 'planner-xtla)
  60
  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))
  67   :group 'planner-xtla)
  68
  69 ;;;###autoload
  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))))))
  77
  78 ;;;###autoload
  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)
  83     t))
  84
  85 ;;;###autoload
  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'."
  90   (interactive)
  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)
  94     (let ((arch-revision)
  95           (planner-xtla-link)
  96           (committed-files))
  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)
 108         (insert "Commit")
 109         (insert (concat " " planner-xtla-link))
 110         (newline)
 111         (when planner-xtla-log-edit-include-files-flag
 112           (insert "Files:\n")
 113           (insert committed-files)
 114           (newline))
 115         (insert (replace-regexp-in-string "^\\*" " *"
 116                                           tla-last-commit-message))))))
 117
 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
 122 `tla--archive-tree'"
 123   (tla--archive-tree-build-archives t)
 124   (let ((reg (concat "\\`xtla:/?/?\\(\\(?:"
 125                      (mapconcat 'car tla--archive-tree "\\|")
 126                      "\\)/\\(?:.*\\)\\)$")))
 127     (save-match-data
 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))))))
 134             (when (nth 1 elts)
 135               (setq subst (concat subst "/" (nth 1 elts)))
 136               (when (nth 2 elts)
 137                 (setq subst (concat subst "/" (nth 1 elts) "--" (nth 2 elts)))
 138                 (when (nth 3 elts)
 139                   (setq subst (concat subst "/" (nth 1 elts) "--" (nth 2 elts)
 140                                       "--" (nth 3 elts)))
 141                   (when (nth 4 elts)
 142                     (setq subst (concat subst "/" (nth 4 elts))))))))
 143         target))))
 144
 145 (add-to-list 'muse-publish-url-transforms 'planner-xtla-url-transform)
 146
 147 (add-hook 'tla-commit-done-hook 'planner-xtla-log-edit-add-note)
 148
 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)
 153
 154 (provide 'planner-xtla)
 155
 156 ;;; planner-xtla.el ends here