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

   1 ;;; patcher-cmtcmd.el --- Commit Command buffers
   2
   3 ;; Copyright (C) 2010, 2011 Didier Verna
   4
   5 ;; Author:        Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer:    Didier Verna <didier@lrde.epita.fr>
   7 ;; Created:       Sun Apr  4 18:44:08 2010
   8 ;; Last Revision: Sun Dec  4 15:54:31 2011
   9 ;; Keywords:      maint
  10
  11
  12 ;; This file is part of Patcher.
  13
  14 ;; Patcher is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License version 3,
  16 ;; as published by the Free Software Foundation.
  17
  18 ;; Patcher is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; if not, write to the Free Software
  25 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27
  28 ;;; Commentary:
  29
  30 ;; Contents management by FCM version 0.1.
  31
  32
  33 ;;; Code:
  34
  35 (require 'cl)
  36
  37 (eval-when-compile (require 'patcher-cutil))
  38 (require 'patcher-util)
  39 (require 'patcher-face)
  40 (require 'patcher-project)
  41 (require 'patcher-instance)
  42
  43
  44 (defgroup patcher-cmtcmd nil
  45   "Patcher settings for commit command buffers."
  46   :group 'patcher)
  47
  48
  49 \f
  50 ;; ==========================================================================
  51 ;; Utilities
  52 ;; ==========================================================================
  53
  54 (defun patcher-cmtcmd-init (command)
  55   ;; Initialize the current commit command buffer with COMMAND.
  56   (insert-string
  57    (substitute-command-keys
  58     "\
  59 # Edit / confirm the commit command below.\n\
  60 # - `\\[patcher-cmtcmd-commit]' to commit the project,\n\
  61 # - `\\[patcher-cmtcmd-cancel]' to cancel the commit,\n\
  62 # - `\\[patcher-cmtcmd-kill]' to kill the project.\n\n"))
  63   (insert-string command))
  64
  65
  66
  67 \f
  68 ;; ==========================================================================
  69 ;; Patcher CmtCmd fontification
  70 ;; ==========================================================================
  71
  72 (defcustom patcher-cmtcmd-font-lock-keywords
  73   '(("^\\s-*#.*" . patcher-comment-face)
  74     ("`\\([^'\n]+\\)'" (1 patcher-reference-face prepend)))
  75   "*Font lock keywords for commit command buffers."
  76   :group 'patcher-cmtcmd
  77   :type 'sexp)
  78
  79
  80
  81 \f
  82 ;; ==========================================================================
  83 ;; Patcher CmtCmd mode
  84 ;; ==========================================================================
  85
  86 (defun patcher-cmtcmd-kill ()
  87   "Kill the project related to the current commit command buffer."
  88   (interactive)
  89   (patcher-kill-project patcher-project))
  90
  91 (defun patcher-cmtcmd-cancel ()
  92   "Cancel the current commit command."
  93   (interactive)
  94   (pop-window-configuration))
  95
  96 (defun patcher-cmtcmd-commit ()
  97   (interactive)
  98   "Commit project with the command in current buffer.
  99 Comment lines are skipped. Other lines are concatenated together."
 100   (patcher-detect-committed-project patcher-project)
 101   (goto-char (point-min))
 102   (let ((command ""))
 103     (while (not (eobp))
 104       (unless (looking-at "[ \t]*#")
 105         (setq command (concat command
 106                               " "
 107                               (buffer-substring (point) (point-at-eol)))))
 108       (forward-line))
 109     (patcher-condition-case nil
 110         (patcher-commit-project patcher-project command)
 111       (commit
 112        (if (interactive-p)
 113            ;; we come from the CmtCmd buffer.
 114            (progn
 115              (display-buffer (patcher-project-process-buffer patcher-project)
 116                              t)
 117              (beep)
 118              (patcher-message "\
 119 Error during commit. Type \\[patcher-cmtcmd-commit] to try again."))
 120          ;; Otherwise, propagate to the caller.
 121          (patcher-error 'commit command))))))
 122
 123 (defcustom patcher-cmtcmd-mode-hook nil
 124   "*Hook to run after setting up Patcher CmtCmd mode."
 125   :group 'patcher-cmtcmd
 126   :type 'hook)
 127
 128 (defvar patcher-cmtcmd-mode-map
 129   (let ((map (make-sparse-keymap)))
 130     (define-key map [(control c) (control p) c] 'patcher-cmtcmd-commit)
 131     (define-key map [(control c) (control c)] 'patcher-cmtcmd-commit)
 132     (define-key map [(control c) (control z)] 'patcher-cmtcmd-cancel)
 133     (define-key map [(control c) (control k)] 'patcher-cmtcmd-kill)
 134     map))
 135
 136 (defun patcher-cmtcmd-mode ()
 137   "Major mode for Patcher commit command management.
 138 You're not supposed to use this mode manually, unless you know what you're
 139 doing.
 140
 141 The following commands are available in a CmtCmd buffer:
 142 \\{patcher-cmtcmd-mode-map}"
 143   (interactive)
 144   (kill-all-local-variables)
 145   (setq major-mode 'patcher-cmtcmd)
 146   (setq mode-name "Patcher-CmtCmd")
 147   (use-local-map patcher-cmtcmd-mode-map)
 148   (setq font-lock-keywords patcher-cmtcmd-font-lock-keywords)
 149   (run-hooks 'patcher-cmtcmd-mode-hook))
 150
 151
 152 (provide 'patcher-cmtcmd)
 153
 154 ;;; patcher-cmtcmd.el ends here