planner-xtla.el

   1 ;;; planner-xtla.el --- Xtla integration for the Emacs Planner
   2
   3 ;; Copyright (C) 2005, 2008 Free Software Foundation, Inc.
   4 ;; Parts copyright (C) 2005, 2008 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 part of Planner.  It is not part of GNU Emacs.
  10
  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 3, or (at your option)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26 ;;;_ + Commentary:
  27
  28 ;; This file allows you to refer to your tla changesets easily from within
  29 ;; a planner page.
  30 ;;
  31 ;; Example:
  32 ;; [[xtla://miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-19][patch-19]]
  33 ;;   can be browsed easily via xtla
  34
  35 ;;; Contributors:
  36
  37 ;; Yann Hodique helped port this to Muse.
  38
  39 ;;; Code:
  40
  41 (require 'planner)
  42 (require 'xtla)
  43
  44 (defgroup planner-xtla nil
  45   "Planner options for the xtla integration."
  46   :prefix "planner-xtla-"
  47   :group 'planner)
  48
  49 (defcustom planner-xtla-log-edit-include-files-flag
  50   t
  51   "Non-nil means include a list of committed files in the note."
  52   :type 'boolean
  53   :group 'planner-xtla)
  54
  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)
  62
  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)
  70
  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))))))
  79
  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))
  86
  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))))))
 119
 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))))
 146
 147 (add-to-list 'muse-publish-url-transforms 'planner-xtla-url-transform)
 148
 149 (add-hook 'tla-commit-done-hook 'planner-xtla-log-edit-add-note)
 150
 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)
 155
 156 (provide 'planner-xtla)
 157
 158 ;;; planner-xtla.el ends here