* riece-mcat.el (riece-mcat-update): New function.
[riece] / lisp / COMPILE
1 ;;; -*- Emacs-Lisp -*-
2
3 (defvar riece-modules
4   (cons 'riece-compat
5         (cons (if (featurep 'xemacs)
6                   'riece-xemacs
7                 'riece-emacs)
8               '(riece-globals
9                 riece-options
10                 riece-debug
11                 riece-package-info
12                 riece-version
13                 riece-coding
14                 riece-complete
15                 riece-mcat
16                 riece-addon-modules
17                 riece-addon
18                 riece-ruby
19                 riece-cache
20
21                 riece-mode
22                 ;; riece-identity -+-> riece-channel
23                 ;;                 +-> riece-user
24                 riece-identity
25                 riece-channel
26                 riece-user
27
28                 riece-misc
29                 riece-signal
30
31                 ;; riece-layout ---> riece-display
32                 riece-layout
33                 riece-display
34                 riece-server
35
36                 ;; riece-channel -+-> riece-naming
37                 ;; riece-user    -+
38                 riece-naming
39                 riece-message
40
41                 ;; riece-filter calls riece-{handle,000,200,300,400,500}
42                 riece-filter
43                 riece-handle
44                 riece-000
45                 riece-200
46                 riece-300
47                 riece-400
48                 riece-500
49
50                 riece-commands
51                 riece-irc
52                 riece))))
53
54 (defvar riece-mcat-modules
55   '(riece-mcat-japanese))
56
57 (defvar riece-icons
58   '("riece-command-quit.xpm"
59     "riece-command-join.xpm"
60     "riece-command-part.xpm"
61     "riece-command-previous-channel.xpm"
62     "riece-command-next-channel.xpm"
63     "riece-command-change-layout.xpm"
64     "riece-submit-bug-report.xpm"))
65
66 (defvar riece-scripts
67   '("server.rb"
68     "aproxy.rb"))
69
70 (defun riece-compile-modules (modules)
71   (let ((load-path (cons nil load-path))
72         error-modules)
73     (while modules
74       (let ((source (expand-file-name
75                      (concat (symbol-name (car modules)) ".el"))))
76         (if (file-newer-than-file-p source (concat source "c"))
77             (condition-case error
78                 (byte-compile-file source)
79               (error
80                (setq error-modules (cons (car modules) error-modules))))))
81       (setq modules (cdr modules)))
82     (if error-modules
83         (princ (concat "\n\
84   WARNING: ---------------------------------------------------------
85   WARNING: Couldn't compile following modules:
86   WARNING: 
87   WARNING:   " (mapconcat #'symbol-name error-modules ", ") "\n\
88   WARNING: 
89   WARNING: You should probably stop here, try \"make distclean\" to clear
90   WARNING: the last build, and then reconfigure.
91   WARNING: ---------------------------------------------------------\n\n")))))
92
93 (defun riece-compile-module ()
94   (let ((load-path (cons nil load-path)))
95     (let ((source (expand-file-name
96                    (concat (car command-line-args-left) ".el"))))
97       (if (file-newer-than-file-p source (concat source "c"))
98           (byte-compile-file source)))))
99
100 (defun riece-install-modules (modules dest just-print)
101   (unless (or just-print (file-exists-p dest))
102     (make-directory dest t))
103   (while modules
104     (let ((name (symbol-name (car modules))))
105       (princ (format "%s.el -> %s\n" name dest))
106       (unless just-print
107         (copy-file (expand-file-name (concat name ".el"))
108                    (expand-file-name (concat name ".el") dest)
109                    t t))
110       (princ (format "%s.elc -> %s\n" name dest))
111       (unless just-print
112         (if (file-exists-p (expand-file-name (concat name ".elc")))
113             (copy-file (expand-file-name (concat name ".elc"))
114                        (expand-file-name (concat name ".elc") dest)
115                        t t)
116           (princ (format "(%s was not successfully compiled, ignored)\n"
117                          name)))))
118     (setq modules (cdr modules))))
119
120 (defun riece-install-icons (icons dest just-print)
121   (unless (or just-print (file-exists-p dest))
122     (make-directory dest t))
123   (while icons
124     (when (file-exists-p (expand-file-name (car icons)))
125       (princ (format "%s -> %s\n" (car icons) dest))
126       (unless just-print
127         (copy-file (expand-file-name (car icons))
128                    (expand-file-name (car icons) dest)
129                    t t)))
130     (setq icons (cdr icons))))
131
132 (defun riece-install-scripts (scripts dest just-print)
133   (unless (or just-print (file-exists-p dest))
134     (make-directory dest t))
135   (while scripts
136     (when (file-exists-p (expand-file-name (car scripts)))
137       (princ (format "%s -> %s\n" (car scripts) dest))
138       (unless just-print
139         (copy-file (expand-file-name (car scripts))
140                    (expand-file-name (car scripts) dest)
141                    t t)))
142     (setq scripts (cdr scripts))))
143
144 (defun riece-install-just-print-p ()
145   (let ((flag (getenv "MAKEFLAGS"))
146         case-fold-search)
147     (if flag
148         (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
149
150 (defun riece-examine-modules ()
151   (let ((load-path (cons nil load-path)))
152     (require 'riece-mcat)
153     (require 'riece-addon-modules)
154     (append riece-modules
155             riece-mcat-modules
156             (mapcar #'car riece-addon-modules))))
157
158 (defun riece-examine ()
159   (princ (mapconcat #'symbol-name (riece-examine-modules) " ")))
160
161 (defun riece-update-mcat ()
162   (let ((modules (riece-examine-modules))
163         (pointer riece-mcat-modules)
164         files)
165     (while pointer
166       (setq modules (delq (car pointer) modules)
167             pointer (cdr pointer)))
168     (setq files (mapcar (lambda (module)
169                           (concat (symbol-name module) ".el"))
170                         modules)
171           pointer riece-mcat-modules)
172     (while pointer
173       (riece-mcat-update files (concat (symbol-name (car pointer)) ".el")
174                          (intern (concat (symbol-name (car pointer))
175                                          "-alist")))
176       (setq pointer (cdr pointer)))))
177
178 (defun riece-compile ()
179   (riece-compile-modules (riece-examine-modules)))
180
181 (defun riece-install ()
182   (riece-install-modules
183    (riece-examine-modules)
184    (expand-file-name "riece" (car command-line-args-left))
185    (riece-install-just-print-p))
186   (riece-install-icons
187    riece-icons
188    (expand-file-name "riece" (car command-line-args-left))
189    (riece-install-just-print-p))
190   (riece-install-scripts
191    riece-scripts
192    (expand-file-name "riece" (car command-line-args-left))
193    (riece-install-just-print-p)))
194
195 (defun riece-compile-package ()
196   (setq autoload-package-name "riece")
197   (add-to-list 'command-line-args-left ".")
198   (batch-update-directory)
199   (add-to-list 'command-line-args-left ".")
200   (Custom-make-dependencies)
201   (riece-compile-modules
202    (append (riece-examine-modules)
203            '(auto-autoloads custom-load))))
204
205 (defun riece-install-package ()
206   (riece-install-modules
207    (append (riece-examine-modules)
208            '(auto-autoloads custom-load))
209    (expand-file-name "lisp/riece" (car command-line-args-left))
210    (riece-install-just-print-p))
211   (riece-install-icons
212    riece-icons
213    (expand-file-name "etc/riece" (car command-line-args-left))
214    (riece-install-just-print-p))
215   (riece-install-scripts
216    riece-scripts
217    (expand-file-name "etc/riece" (car command-line-args-left))
218    (riece-install-just-print-p)))
219
220 (defun riece-test ()
221   (let ((load-path (cons (expand-file-name "test") (cons nil load-path)))
222         (files (directory-files "test" t "^test-.*\\.el$"))
223         suite)
224     (require 'lunit-report)
225     (setq suite (lunit-make-test-suite))
226     (while files
227       (when (file-regular-p (car files))
228         (load-file (car files))
229         (lunit-test-suite-add-test
230          suite
231          (lunit-make-test-suite-from-class
232           (intern (file-name-sans-extension
233                    (file-name-nondirectory (car files)))))))
234       (setq files (cdr files)))
235     (lunit-report suite (car command-line-args-left))))