cgit.sxemacs.org Git - packages/blob - xemacs-packages/patcher/lisp/patcher-logmsg.el

   1 ;;; patcher-logmsg.el --- Log message buffers
   2
   3 ;; Copyright (C) 2008, 2009, 2010, 2011 Didier Verna
   4 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Didier Verna
   5
   6 ;; Author:        Didier Verna <didier@xemacs.org>
   7 ;; Maintainer:    Didier Verna <didier@xemacs.org>
   8 ;; Created:       Sat Feb 13 18:24:56 2010
   9 ;; Last Revision: Sun Dec  4 15:54:18 2011
  10 ;; Keywords:      maint
  11
  12
  13 ;; This file is part of Patcher.
  14
  15 ;; Patcher is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License version 3,
  17 ;; as published by the Free Software Foundation.
  18
  19 ;; Patcher is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; if not, write to the Free Software
  26 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28
  29 ;;; Commentary:
  30
  31 ;; Contents management by FCM version 0.1.
  32
  33
  34 ;;; Code:
  35
  36 (require 'cl)
  37
  38 (eval-when-compile (require 'patcher-cutil))
  39 (require 'patcher-util)
  40 (require 'patcher-face)
  41 (require 'patcher-project)
  42 (require 'patcher-instance)
  43 (require 'patcher-source)
  44 (require 'patcher-change-log)
  45 (require 'patcher-cmtcmd)
  46
  47
  48 (defgroup patcher-logmsg nil
  49   "Patcher settings for log message buffers."
  50   :group 'patcher)
  51
  52
  53 \f
  54 ;; ==========================================================================
  55 ;; Patcher LogMsg fontification
  56 ;; ==========================================================================
  57
  58 (defcustom patcher-logmsg-font-lock-keywords
  59   '(("^\\s-*#.*" . patcher-comment-face)
  60     ("`\\([^'\n]+\\)'" (1 patcher-reference-face prepend)))
  61   "*Font lock keywords for log message buffers."
  62   :group 'patcher-logmsg
  63   :type 'sexp)
  64
  65
  66
  67 \f
  68 ;; ==========================================================================
  69 ;; Patcher LogMsg mode
  70 ;; ==========================================================================
  71
  72 (defun patcher-logmsg-insert-subject (&optional prefix)
  73   "Insert subject at point in current buffer.
  74
  75 PREFIX is a string to insert before the subject, if there is indeed
  76 a subject to insert (unavailable interactively).
  77
  78 Return non-nil if something has indeed been inserted."
  79   (interactive)
  80   ;; Note that we allow this function to insert the subject anywhere, even in
  81   ;; the middle of a line.
  82   (let* ((subject (patcher-project-subject patcher-project))
  83          (doit (not (zerop (length subject)))))
  84     (when doit
  85       (when prefix
  86         (insert prefix))
  87       (insert subject))
  88     doit))
  89
  90 (defun patcher-logmsg-change-subject ()
  91   "Read a new subject for the current project.
  92
  93 The new subject is propagated to all relevant buffers."
  94   (interactive)
  95   (patcher-change-subject patcher-project))
  96
  97 (defun patcher-logmsg-insert-change-logs (&optional separator prefix)
  98   "Insert ChangeLog entries at point in current buffer.
  99
 100 If SEPARATOR is non-nil (prefix argument when called interactively),
 101 also insert the ChangeLog separator string defined by the
 102 :change-logs-separator project option \(but only if there are indeed
 103 ChangeLog entries to insert).
 104
 105 PREFIX is an additional string to insert before anything else,
 106 if there is indeed something to insert (unavailable interactively).
 107
 108 Return non-nil if something has indeed been inserted."
 109   (interactive "P")
 110   (let ((beg (point)))
 111     (when (patcher-insert-change-log-contents patcher-project beg)
 112       (save-excursion
 113         (goto-char beg)
 114         ;; Ensure that we start at the beginning of a line,
 115         (unless (point-at-bol)
 116           (insert "\n"))
 117         (when prefix
 118           (insert prefix))
 119         (when separator
 120           (setq separator (patcher-project-option patcher-project
 121                             :change-logs-separator))
 122           (unless (zerop (length separator))
 123             (insert separator "\n\n"))))
 124       t)))
 125
 126 (defun patcher-logmsg-insert-compressed-change-logs
 127   (&optional separator prefix)
 128   "Insert compressed ChangeLog entries in the current Patcher LogMsg buffer.
 129
 130 If SEPARATOR is non-nil (prefix argument when called interactively),
 131 also insert the ChangeLog separator string defined by the
 132 :change-logs-separator project option \(but only if there are indeed
 133 ChangeLog entries to insert).
 134
 135 PREFIX is an additional string to insert before anything else,
 136 if there is indeed something to insert (unavailable interactively).
 137
 138 Return non-nil if something has indeed been inserted."
 139   (interactive)
 140   (when (patcher-logmsg-insert-change-logs separator prefix)
 141     (patcher-compress-change-logs)
 142     t))
 143
 144 (defun patcher-logmsg-commit (&optional arg)
 145   "Commit the change described in the current Patcher LogMsg buffer.
 146
 147 When called interactively, use a prefix to override the commit command.
 148 The actual log message starts at the first non-blank and non-comment line
 149 in this buffer."
 150   (interactive "P")
 151   (patcher-detect-committed-project patcher-project)
 152   (patcher-save-sources patcher-project)
 153   (patcher-save-change-logs patcher-project)
 154   (when arg
 155     (setf (patcher-project-commit-command patcher-project)
 156           (read-shell-command "Commit command: "
 157                               (patcher-project-commit-command
 158                                patcher-project))))
 159   ;; Make sure that the log buffer ends with one and only one newline
 160   ;; character. Empty lines are useless, and I've noticed a bug in Darcs which
 161   ;; makes it append the interactive ***END OF DESCRIPTION*** stuff to the log
 162   ;; file contents, when it doesn't end with a newline character.
 163   (goto-char (point-max))
 164   (cond ((looking-at "\\'")
 165          (skip-chars-backward "\n")
 166          (delete-region (point) (1- (point-max))))
 167         (t
 168          (insert "\n")))
 169   ;; Reach the start of the log message (skip initial comment and blank
 170   ;; lines).
 171   (goto-char (point-min))
 172   (while (and (not (eobp)) (looking-at "[ \t]*#\\|$"))
 173     (forward-line))
 174   ;; Ensure there is something in the log message.
 175   (when (eobp)
 176     (save-excursion (insert "(none)\n")))
 177   ;; Write out the log message to the logmsg file.
 178   (unless (patcher-project-logmsg-file-name patcher-project)
 179     (setf (patcher-project-logmsg-file-name patcher-project)
 180           (make-temp-name (expand-file-name "patch" (temp-directory)))))
 181   (write-region (point) (point-max)
 182                 (patcher-project-logmsg-file-name patcher-project)
 183                 nil 'silent)
 184   ;; Compute the final commit command.
 185   (let ((command (patcher-project-commit-command patcher-project)))
 186     (setq command
 187           (let (case-fold-search)
 188             (replace-in-string
 189              command
 190              "%S" (shell-quote-argument
 191                    ;; If the log message is put directly on the command line
 192                    ;; and not extracted from the logmsg file, take care of
 193                    ;; removing the final newline.
 194                    (buffer-substring (point) (1- (point-max)))) t)))
 195     (setq command
 196           (replace-in-string command "%s"
 197                              (patcher-project-logmsg-file-name
 198                               patcher-project)
 199                              t))
 200     (setq command (patcher-command patcher-project command t))
 201     (let ((buffer (patcher-project-cmtcmd-buffer patcher-project)))
 202       (if buffer
 203           (erase-buffer buffer)
 204         (setq buffer
 205               (setf (patcher-project-cmtcmd-buffer patcher-project)
 206                     (generate-new-buffer
 207                      (format "*%s Patcher Project Commit Command*"
 208                          (patcher-project-name patcher-project)))))
 209         ;; Do it first! It kills local variables.
 210         (with-current-buffer buffer
 211           (patcher-cmtcmd-mode))
 212         (patcher-setup-auxiliary-buffer patcher-project buffer)))
 213     (if (not (patcher-project-option patcher-project :edit-commit-command))
 214         (with-current-buffer (patcher-project-cmtcmd-buffer patcher-project)
 215           (patcher-cmtcmd-init command)
 216           (patcher-condition-case nil
 217               (patcher-cmtcmd-commit)
 218             (commit
 219              (if (interactive-p)
 220                  ;; we come from the LogMsg buffer.
 221                  (progn
 222                    (display-buffer
 223                     (patcher-project-process-buffer patcher-project)
 224                     t)
 225                    (with-current-buffer (patcher-project-logmsg-buffer
 226                                          patcher-project)
 227                      (beep)
 228                      (patcher-message "\
 229 Error during commit. Type \\[patcher-logmsg-commit] to try again.")))
 230                ;; Otherwise, propagate to the caller.
 231                (patcher-error 'commit command)))))
 232       (switch-to-buffer (patcher-project-cmtcmd-buffer patcher-project))
 233       (patcher-cmtcmd-init command))))
 234
 235 (defun patcher-logmsg-kill ()
 236   "Kill the project related to the current log message buffer."
 237   (interactive)
 238   (patcher-kill-project patcher-project))
 239
 240 (defun patcher-logmsg-cancel ()
 241   "Cancel the current log message."
 242   (interactive)
 243   (pop-window-configuration))
 244
 245 (defun patcher-logmsg-init ()
 246   "(Re)Init the log message in the current Patcher LogMsg buffer.
 247
 248 This is done conforming to the :log-message-items project option.
 249 The actual log message starts at the first non-blank and non-comment line
 250 in this buffer."
 251   (interactive)
 252   (erase-buffer)
 253   (insert-string
 254    (substitute-command-keys
 255     "\
 256 # Edit / confirm the log message below.\n\
 257 # - `\\[patcher-logmsg-commit]' to commit the project,\n\
 258 # - `\\[patcher-logmsg-cancel]' to cancel the commit,\n\
 259 # - `\\[patcher-logmsg-kill]' to kill the project.\n\n"))
 260   (let ((point (point))
 261         inserted)
 262     (dolist (item (patcher-project-option patcher-project :log-message-items))
 263       (setq inserted
 264             (cond ((eq item 'subject)
 265                    (patcher-logmsg-insert-subject (and inserted "\n\n")))
 266                   ((eq item 'compressed-change-logs)
 267                    (patcher-logmsg-insert-compressed-change-logs
 268                     inserted
 269                     (and inserted "\n\n")))
 270                   ((eq item 'change-logs)
 271                    (patcher-logmsg-insert-change-logs
 272                     inserted
 273                     (and inserted "\n\n")))
 274                   (t
 275                    (patcher-error "invalid log message item: %s" item)))))
 276     (goto-char point)))
 277
 278 (defcustom patcher-logmsg-mode-hook nil
 279   "*Hook to run after setting up Patcher LogMsg mode."
 280   :group 'patcher-logmsg
 281   :type 'hook)
 282
 283 (defvar patcher-logmsg-mode-map
 284   (let ((map (make-sparse-keymap)))
 285     (define-key map [(control c) (control p) i] 'patcher-logmsg-init)
 286     (define-key map [(control c) (control p) s] 'patcher-logmsg-insert-subject)
 287     (define-key map [(control c) (control p) S] 'patcher-logmsg-change-subject)
 288     (define-key map [(control c) (control p) l]
 289       'patcher-logmsg-insert-change-logs)
 290     (define-key map [(control c) (control p) L]
 291       'patcher-logmsg-insert-compressed-change-logs)
 292     (define-key map [(control c) (control p) c] 'patcher-logmsg-commit)
 293     (define-key map [(control c) (control c)] 'patcher-logmsg-commit)
 294     (define-key map [(control c) (control z)] 'patcher-logmsg-cancel)
 295     (define-key map [(control c) (control k)] 'patcher-logmsg-kill)
 296     map))
 297
 298 (defun patcher-logmsg-mode ()
 299   "Major mode for Patcher commit log message management.
 300
 301 You're not supposed to use this mode manually, unless you know what you're
 302 doing.
 303
 304 The following commands are available in a LogMsg buffer:
 305 \\{patcher-logmsg-mode-map}"
 306   (interactive)
 307   (kill-all-local-variables)
 308   (setq major-mode 'patcher-logmsg)
 309   (setq mode-name "Patcher-LogMsg")
 310   (use-local-map patcher-logmsg-mode-map)
 311   (setq font-lock-keywords patcher-logmsg-font-lock-keywords)
 312   (run-hooks 'patcher-logmsg-mode-hook))
 313
 314
 315 (provide 'patcher-logmsg)
 316
 317 ;;; patcher-logmsg.el ends here