nxhtml/util/udev-ecb.el

   1 ;;; udev-ecb.el --- Get ECB sources and set it up
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2008-08-25T04:02:37+0200 Mon
   5 (defconst udev-ecb:version "0.2");; Version:
   6 ;; Last-Updated:
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;;
  20 ;;
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;;
  23 ;;; Change log:
  24 ;;
  25 ;;
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;; This program is free software; you can redistribute it and/or
  29 ;; modify it under the terms of the GNU General Public License as
  30 ;; published by the Free Software Foundation; either version 2, or
  31 ;; (at your option) any later version.
  32 ;;
  33 ;; This program is distributed in the hope that it will be useful,
  34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  36 ;; General Public License for more details.
  37 ;;
  38 ;; You should have received a copy of the GNU General Public License
  39 ;; along with this program; see the file COPYING.  If not, write to
  40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  41 ;; Floor, Boston, MA 02110-1301, USA.
  42 ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;
  45 ;;; Code:
  46
  47
  48 (eval-when-compile (require 'udev nil t))
  49
  50 (defgroup udev-ecb nil
  51   "Customization group for udev-ecb."
  52   :group 'nxhtml)
  53
  54 (defcustom udev-ecb-dir "~/.emacs.d/udev/ecb-cvs/"
  55   "Directory where to put CVS ECB sources."
  56   :type 'directory
  57   :group 'udev-ecb)
  58
  59 (defun udev-ecb-cvs-dir ()
  60   "Return cvs root directory."
  61   (file-name-as-directory (expand-file-name "ecb" udev-ecb-dir)))
  62
  63 (defvar udev-ecb-miss-cedet nil)
  64
  65 (defun udev-ecb-load-ecb ()
  66   "Load fetched ECB."
  67   (setq udev-ecb-miss-cedet nil)
  68   (unless (featurep 'ecb)
  69     (add-to-list 'load-path (udev-ecb-cvs-dir))
  70     (let ((msg nil))
  71       (unless (or msg (featurep 'cedet)) (setq msg "CEDET is not loaded"))
  72       (unless (or msg (locate-library "semantic")) (setq msg "can't find CEDET Semantic"))
  73       (unless (or msg (locate-library "eieio")) (setq msg "can't find CEDET eieio"))
  74       (if msg
  75           (progn
  76             (setq udev-ecb-miss-cedet (format "Can't load ECB because %s." msg))
  77             (ourcomments-warning udev-ecb-miss-cedet))
  78         (require 'ecb nil t)))))
  79
  80 (defcustom udev-ecb-load-ecb nil
  81   "To load or not to load ECB..."
  82   :type 'boolean
  83   :require 'udev-ecb
  84   :set (lambda (sym val)
  85          (set-default sym val)
  86          (when val
  87            (udev-ecb-load-ecb)))
  88   ;; ecb-activate, ecb-customize-most-important to menu
  89   :set-after '(udev-cedet-load-cedet)
  90   :group 'udev-ecb)
  91
  92 (defvar udev-ecb-steps
  93   '(udev-ecb-fetch
  94     udev-ecb-fix-bad-files
  95     udev-ecb-fetch-diff
  96     udev-ecb-check-diff
  97     udev-ecb-install
  98     ))
  99
 100 (defun udev-ecb-buffer-name (mode)
 101   "Return a name for current compilation buffer ignoring MODE."
 102   (udev-buffer-name "*Updating ECB %s*" udev-ecb-update-buffer mode))
 103
 104 (defvar udev-ecb-update-buffer nil)
 105
 106 (defun udev-ecb-has-cedet ()
 107   (cond
 108    ((not (and (locate-library "semantic")
 109                 (locate-library "eieio")))
 110     (message (propertize "CEDET must be installed and loaded first"
 111                          'face 'secondary-selection))
 112     nil)
 113    ((not (featurep 'cedet))
 114     (message (propertize "CEDET must be loaded first"
 115                          'face 'secondary-selection))
 116     nil)
 117    (t t)))
 118
 119 (defun udev-ecb-setup-when-finished (log-buffer)
 120   (require 'cus-edit)
 121   (let ((inhibit-read-only t))
 122     (with-current-buffer log-buffer
 123       (widen)
 124       (goto-char (point-max))
 125       (insert "\n\nYou must restart Emacs to load ECB properly.\n")
 126       (let ((load-ecb-saved-value (get 'udev-ecb-load-ecb 'saved-value))
 127             (here (point))
 128             )
 129         (if load-ecb-saved-value
 130             (insert "You have setup to load ECB the next time you start Emacs.\n\n")
 131           (insert (propertize "Warning:" 'face 'compilation-warning)
 132                   " You have not setup to load ECB the next time you start Emacs.\n\n"))
 133         (insert-button " Setup "
 134                        'face 'custom-button
 135                        'action (lambda (btn)
 136                                  (interactive)
 137                                  (customize-group-other-window 'udev-ecb)))
 138         (insert " Setup to load ECB from fetched sources when starting Emacs.")))))
 139
 140 ;;;###autoload
 141 (defun udev-ecb-update ()
 142   "Fetch and install ECB from the devel sources.
 143 To determine where to store the sources see `udev-ecb-dir'.
 144 For how to start ECB see `udev-ecb-load-ecb'."
 145   (interactive)
 146   (when (udev-ecb-has-cedet)
 147     (let* ((has-it (file-exists-p (udev-ecb-cvs-dir)))
 148            (prompt (if has-it
 149                        "Do you want to update ECB from devel sources? "
 150                      "Do you want to install ECB from devel sources? ")))
 151       (when (y-or-n-p prompt)
 152         (setq udev-ecb-update-buffer (get-buffer-create "*Update ECB*"))
 153         (udev-call-first-step udev-ecb-update-buffer udev-ecb-steps
 154                               "Starting updating ECB from development sources"
 155                               'udev-ecb-setup-when-finished)))))
 156
 157 ;;;###autoload
 158 (defun udev-ecb-customize-startup ()
 159   "Customize ECB dev nXhtml startup group."
 160   (interactive)
 161   (if (file-exists-p (udev-ecb-cvs-dir))
 162       (customize-group-other-window 'udev-ecb)
 163     (message (propertize "You must fetch ECB from nXhtml first"
 164                          'face 'secondary-selection))))
 165
 166 (defun udev-ecb-fetch (log-buffer)
 167   "Fetch ECB sources (asynchronously)."
 168   (let ((default-directory (file-name-as-directory udev-ecb-dir)))
 169     (unless (file-directory-p default-directory)
 170       (make-directory default-directory))
 171     (with-current-buffer
 172         (compilation-start
 173          "cvs -z3 -d:pserver:anonymous@ecb.cvs.sourceforge.net:/cvsroot/ecb co -P ecb"
 174          'compilation-mode
 175          'udev-ecb-buffer-name)
 176       (current-buffer))))
 177
 178 ;;(udev-ecb-fix-bad-files nil)
 179 (defun udev-ecb-fix-bad-files (log-buffer)
 180   "Change files that can not be compiled."
 181   (let* ((bad-file (expand-file-name "ecb/ecb-advice-test.el" udev-ecb-dir))
 182          (bad-file-buffer (find-buffer-visiting bad-file))
 183          (this-log-buf (get-buffer-create "*Fix bad ECB files*"))
 184          (fixed-it nil))
 185     (when (file-exists-p bad-file)
 186       (with-current-buffer (find-file-noselect bad-file)
 187         (save-restriction
 188           (widen)
 189           (goto-char (point-min))
 190           (save-match-data
 191             (while (re-search-forward "\r" nil t)
 192               (setq fixed-it t)
 193               (replace-match ""))))
 194         (basic-save-buffer)
 195         (with-current-buffer this-log-buf
 196           (erase-buffer)
 197           (if fixed-it
 198               (insert "Fixed " bad-file "\n")
 199             (insert "The file " bad-file " was already ok\n")))
 200         (unless bad-file-buffer (kill-buffer (current-buffer)))))
 201     this-log-buf))
 202
 203 (defun udev-ecb-fetch-diff (log-buffer)
 204   "Fetch diff between local ECB sources and repository."
 205   (udev-fetch-cvs-diff (udev-ecb-cvs-dir) 'udev-ecb-buffer-name))
 206
 207 (defun udev-ecb-check-diff (log-buffer)
 208   "Check cvs diff output for merge conflicts."
 209   (udev-check-cvs-diff (expand-file-name "your-patches.diff"
 210                                           (udev-ecb-cvs-dir))
 211                         udev-ecb-update-buffer))
 212
 213 (defun udev-ecb-install (log-buffer)
 214   "Install the ECB sources just fetched.
 215 Note that they will not be installed in current Emacs session."
 216   (udev-batch-compile "-l ecb-batch-compile.el"
 217                       udev-this-dir
 218                       'udev-ecb-buffer-name))
 219
 220 ;;(udev-ecb-install-help (get-buffer-create "*temp online-help*"))
 221 (defun udev-ecb-install-help (log-buffer)
 222   (let ((trc-buf (get-buffer-create "*temp online-help*")))
 223     (with-current-buffer trc-buf
 224       (setq default-directory (udev-ecb-cvs-dir))
 225       (w32shell-with-shell "msys" (shell-command "make online-help&" trc-buf)))))
 226
 227 (provide 'udev-ecb)
 228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 229 ;;; udev-ecb.el ends here