emacs/nxhtml/util/udev-rinari.el

   1 ;;; udev-rinari.el --- Get rinary sources and set it up
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2008-08-24T22:32:21+0200 Sun
   5 (defconst udev-rinari: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 (eval-when-compile (require 'udev nil t))
  48
  49 (defgroup udev-rinari nil
  50   "Customization group for udev-rinari."
  51   :group 'nxhtml)
  52
  53 (defcustom udev-rinari-dir "~/rinari-svn/"
  54   "Directory where to put SVN Rinari sources."
  55   :type 'directory
  56   :group 'udev-rinari)
  57
  58 (defcustom udev-rinari-load-rinari nil
  59   "To load or not to load Rinari..."
  60   :type '(choice (const :tag "Don't load Rinari" nil)
  61                  (const :tag "Load Rinari" t))
  62   :set (lambda (sym val)
  63          (set-default sym val)
  64          (when val
  65            (let* ((base-dir  (expand-file-name "svn/trunk/" udev-rinari-dir))
  66                   (rhtml-dir (expand-file-name "rhtml/" base-dir))
  67                   (test-dir  (expand-file-name "test/lisp/" base-dir)))
  68              (unless (file-directory-p base-dir)  (message "Can't find %s" base-dir))
  69              (unless (file-directory-p rhtml-dir) (message "Can't find %s" rhtml-dir))
  70              (unless (file-directory-p test-dir)  (message "Can't find %s" test-dir))
  71              (add-to-list 'load-path base-dir)
  72              (add-to-list 'load-path rhtml-dir)
  73              (add-to-list 'load-path test-dir))
  74            (require 'rinari)
  75            (require 'ruby-mode)))
  76   :group 'udev-rinari)
  77
  78 (defvar udev-rinari-steps
  79   '(udev-rinari-fetch
  80     udev-rinari-fetch-diff
  81     udev-rinari-check-diff
  82     ;;udev-rinari-install
  83     ))
  84
  85 (defvar udev-rinari-update-buffer nil)
  86
  87 (defun udev-rinari-buffer-name (mode)
  88   "Return a name for current compilation buffer ignoring MODE."
  89   (udev-buffer-name "*Updating Rinari %s*" udev-rinari-update-buffer mode))
  90
  91 (defun udev-rinari-check-conflicts ()
  92   "Check if Rinari and ruby-mode already loaded and from where.
  93 Give an error if they are loaded from somewhere else than
  94 `udev-rinari-dir' tree."
  95   (when (featurep 'rinari)
  96     (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "rinari")))))
  97           (new-dir (expand-file-name "svn/trunk/" udev-rinari-dir)))
  98       (unless (string= (file-truename old-dir)
  99                        (file-truename new-dir))
 100         (error "Rinari is already loaded from: %s" old-dir))))
 101   (when (featurep 'ruby-mode)
 102     (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "ruby-mode")))))
 103           (new-dir (expand-file-name "svn/trunk/test/lisp/" udev-rinari-dir)))
 104       (unless (string= (file-truename old-dir)
 105                        (file-truename new-dir))
 106         (error "Ruby-mode is already loaded from: %s" old-dir))))
 107   )
 108
 109 (defun udev-rinari-setup-when-finished (log-buffer)
 110   (let ((inhibit-read-only t))
 111     (with-current-buffer log-buffer
 112       (widen)
 113       (goto-char (point-max))
 114       (insert "\n\nYou must restart Emacs to load Rinari properly.\n")
 115       (let ((load-rinari-saved-value (get 'udev-rinari-load-rinari 'saved-value))
 116             (here (point))
 117             )
 118         (if load-rinari-saved-value
 119             (insert "You have setup to load Rinari the next time you start Emacs.\n\n")
 120           (insert (propertize "Warning:" 'face 'compilation-warning)
 121                   " You have not setup to load Rinari the next time you start Emacs.\n\n"))
 122         (insert-button " Setup "
 123                        'face 'custom-button
 124                        'action (lambda (btn)
 125                                  (interactive)
 126                                  (customize-group-other-window 'udev-rinari)))
 127         (insert " Setup to load Rinari from fetched sources when starting Emacs.")))))
 128
 129 ;;;###autoload
 130 (defun udev-rinari-update ()
 131   "Fetch and install Rinari from the devel sources.
 132 To determine where to store the sources and how to start rinari
 133 see `udev-rinari-dir' and `udev-rinari-load-rinari'."
 134   (interactive)
 135   (udev-rinari-check-conflicts)
 136   (setq udev-rinari-update-buffer (get-buffer-create "*Update Rinari*"))
 137   (udev-call-first-step udev-rinari-update-buffer udev-rinari-steps
 138                         "Starting updating Rinari from development sources"
 139                         'udev-rinari-setup-when-finished))
 140
 141 (defvar udev-rinari-fetch-buffer nil)
 142
 143 (defun udev-rinari-fetch (log-buffer)
 144   "Fetch Rinari from development sources."
 145   (let* ((default-directory (file-name-as-directory udev-rinari-dir)) ;; fix-me: for emacs bug
 146          )
 147     (unless (file-directory-p default-directory)
 148       (make-directory default-directory))
 149     (with-current-buffer
 150         (compilation-start
 151          "svn checkout http://rinari.rubyforge.org/svn/"
 152          'compilation-mode
 153          'udev-rinari-buffer-name)
 154       (setq udev-rinari-fetch-buffer (current-buffer)))))
 155
 156 (defvar udev-rinari-diff-file nil)
 157 (defvar udev-rinari-fetch-diff-buffer nil)
 158
 159 (defun udev-rinari-fetch-diff (log-buffer)
 160   "Fetch diff between local Rinari sources and dev repository."
 161   (let ((must-fetch-diff t))
 162     (setq udev-rinari-fetch-diff-buffer
 163           (when must-fetch-diff
 164             (let* ((default-directory (file-name-as-directory
 165                                        (expand-file-name "svn"
 166                                                          udev-rinari-dir))))
 167               (setq udev-rinari-diff-file (expand-file-name "../patches.diff"))
 168               (with-current-buffer
 169                   (compilation-start
 170                    (concat "svn diff > " (shell-quote-argument udev-rinari-diff-file))
 171                    'compilation-mode
 172                    'udev-rinari-buffer-name)
 173                 (setq udev-continue-on-error-function 'udev-cvs-diff-continue)
 174                 (current-buffer)))))))
 175
 176 (defun udev-rinari-check-diff (log-buffer)
 177   "Check output from svn diff command for merge conflicts."
 178   ;; Fix-me: How can this be checked?
 179   (when udev-rinari-fetch-diff-buffer
 180     (let ((buf (find-buffer-visiting udev-rinari-diff-file)))
 181       (if buf
 182           (with-current-buffer buf (revert-buffer nil t))
 183         (setq buf (find-file-noselect udev-rinari-diff-file)))
 184       (with-current-buffer buf
 185         (widen)
 186         (goto-char (point-min))
 187         (if (search-forward "<<<<<<<" nil t)
 188             ;; Merge conflict
 189             (udev-call-next-step udev-rinari-update-buffer 1 nil)
 190           buf)))))
 191
 192 ;; (defun udev-rinari-install ()
 193 ;;   "Install Rinari and ruby-mode for use."
 194 ;;   (if udev-rinari-load-rinari
 195 ;;       (message "Rinari should be loaded now")
 196 ;;     (when (y-or-n-p
 197 ;;            "You need to set udev-rinari-load-rinari.  Do that now? ")
 198 ;;       (customize-group-other-window 'udev-rinari)))
 199 ;;   nil)
 200
 201
 202 (provide 'udev-rinari)
 203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 204 ;;; udev-rinari.el ends here