summaryrefslogtreecommitdiffstats
path: root/emacs.d/nxhtml/util/udev-rinari.el
blob: ed70c6c5607849b7b9d80323fb6585ba9679f90a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
;;; udev-rinari.el --- Get rinary sources and set it up
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: 2008-08-24T22:32:21+0200 Sun
(defconst udev-rinari:version "0.2");; Version:
;; Last-Updated:
;; URL:
;; Keywords:
;; Compatibility:
;;
;; Features that might be required by this library:
;;
;;   None
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

(eval-when-compile (require 'udev nil t))

(defgroup udev-rinari nil
  "Customization group for udev-rinari."
  :group 'nxhtml)

(defcustom udev-rinari-dir "~/rinari-svn/"
  "Directory where to put SVN Rinari sources."
  :type 'directory
  :group 'udev-rinari)

(defcustom udev-rinari-load-rinari nil
  "To load or not to load Rinari..."
  :type '(choice (const :tag "Don't load Rinari" nil)
                 (const :tag "Load Rinari" t))
  :set (lambda (sym val)
         (set-default sym val)
         (when val
           (let* ((base-dir  (expand-file-name "svn/trunk/" udev-rinari-dir))
                  (rhtml-dir (expand-file-name "rhtml/" base-dir))
                  (test-dir  (expand-file-name "test/lisp/" base-dir)))
             (unless (file-directory-p base-dir)  (message "Can't find %s" base-dir))
             (unless (file-directory-p rhtml-dir) (message "Can't find %s" rhtml-dir))
             (unless (file-directory-p test-dir)  (message "Can't find %s" test-dir))
             (add-to-list 'load-path base-dir)
             (add-to-list 'load-path rhtml-dir)
             (add-to-list 'load-path test-dir))
           (require 'rinari)
           (require 'ruby-mode)))
  :group 'udev-rinari)

(defvar udev-rinari-steps
  '(udev-rinari-fetch
    udev-rinari-fetch-diff
    udev-rinari-check-diff
    ;;udev-rinari-install
    ))

(defvar udev-rinari-update-buffer nil)

(defun udev-rinari-buffer-name (mode)
  "Return a name for current compilation buffer ignoring MODE."
  (udev-buffer-name "*Updating Rinari %s*" udev-rinari-update-buffer mode))

(defun udev-rinari-check-conflicts ()
  "Check if Rinari and ruby-mode already loaded and from where.
Give an error if they are loaded from somewhere else than
`udev-rinari-dir' tree."
  (when (featurep 'rinari)
    (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "rinari")))))
          (new-dir (expand-file-name "svn/trunk/" udev-rinari-dir)))
      (unless (string= (file-truename old-dir)
                       (file-truename new-dir))
        (error "Rinari is already loaded from: %s" old-dir))))
  (when (featurep 'ruby-mode)
    (let ((old-dir (file-name-directory (car (load-history-filename-element (load-history-regexp "ruby-mode")))))
          (new-dir (expand-file-name "svn/trunk/test/lisp/" udev-rinari-dir)))
      (unless (string= (file-truename old-dir)
                       (file-truename new-dir))
        (error "Ruby-mode is already loaded from: %s" old-dir))))
  )

(defun udev-rinari-setup-when-finished (log-buffer)
  (let ((inhibit-read-only t))
    (with-current-buffer log-buffer
      (widen)
      (goto-char (point-max))
      (insert "\n\nYou must restart Emacs to load Rinari properly.\n")
      (let ((load-rinari-saved-value (get 'udev-rinari-load-rinari 'saved-value))
            (here (point))
            )
        (if load-rinari-saved-value
            (insert "You have setup to load Rinari the next time you start Emacs.\n\n")
          (insert (propertize "Warning:" 'face 'compilation-warning)
                  " You have not setup to load Rinari the next time you start Emacs.\n\n"))
        (insert-button " Setup "
                       'face 'custom-button
                       'action (lambda (btn)
                                 (interactive)
                                 (customize-group-other-window 'udev-rinari)))
        (insert " Setup to load Rinari from fetched sources when starting Emacs.")))))

;;;###autoload
(defun udev-rinari-update ()
  "Fetch and install Rinari from the devel sources.
To determine where to store the sources and how to start rinari
see `udev-rinari-dir' and `udev-rinari-load-rinari'."
  (interactive)
  (udev-rinari-check-conflicts)
  (setq udev-rinari-update-buffer (get-buffer-create "*Update Rinari*"))
  (udev-call-first-step udev-rinari-update-buffer udev-rinari-steps
                        "Starting updating Rinari from development sources"
                        'udev-rinari-setup-when-finished))

(defvar udev-rinari-fetch-buffer nil)

(defun udev-rinari-fetch (log-buffer)
  "Fetch Rinari from development sources."
  (let* ((default-directory (file-name-as-directory udev-rinari-dir)) ;; fix-me: for emacs bug
         )
    (unless (file-directory-p default-directory)
      (make-directory default-directory))
    (with-current-buffer
        (compilation-start
         "svn checkout http://rinari.rubyforge.org/svn/"
         'compilation-mode
         'udev-rinari-buffer-name)
      (setq udev-rinari-fetch-buffer (current-buffer)))))

(defvar udev-rinari-diff-file nil)
(defvar udev-rinari-fetch-diff-buffer nil)

(defun udev-rinari-fetch-diff (log-buffer)
  "Fetch diff between local Rinari sources and dev repository."
  (let ((must-fetch-diff t))
    (setq udev-rinari-fetch-diff-buffer
          (when must-fetch-diff
            (let* ((default-directory (file-name-as-directory
                                       (expand-file-name "svn"
                                                         udev-rinari-dir))))
              (setq udev-rinari-diff-file (expand-file-name "../patches.diff"))
              (with-current-buffer
                  (compilation-start
                   (concat "svn diff > " (shell-quote-argument udev-rinari-diff-file))
                   'compilation-mode
                   'udev-rinari-buffer-name)
                (setq udev-continue-on-error-function 'udev-cvs-diff-continue)
                (current-buffer)))))))

(defun udev-rinari-check-diff (log-buffer)
  "Check output from svn diff command for merge conflicts."
  ;; Fix-me: How can this be checked?
  (when udev-rinari-fetch-diff-buffer
    (let ((buf (find-buffer-visiting udev-rinari-diff-file)))
      (if buf
          (with-current-buffer buf (revert-buffer nil t))
        (setq buf (find-file-noselect udev-rinari-diff-file)))
      (with-current-buffer buf
        (widen)
        (goto-char (point-min))
        (if (search-forward "<<<<<<<" nil t)
            ;; Merge conflict
            (udev-call-next-step udev-rinari-update-buffer 1 nil)
          buf)))))

;; (defun udev-rinari-install ()
;;   "Install Rinari and ruby-mode for use."
;;   (if udev-rinari-load-rinari
;;       (message "Rinari should be loaded now")
;;     (when (y-or-n-p
;;            "You need to set udev-rinari-load-rinari.  Do that now? ")
;;       (customize-group-other-window 'udev-rinari)))
;;   nil)


(provide 'udev-rinari)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; udev-rinari.el ends here