8bbae79f8ec41b9006b71243917ea1d8ffc6e67a
[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-previous-channel.xpm"
59     "riece-command-next-channel.xpm"
60     "riece-command-configure-windows.xpm"
61     "riece-command-list-addons.xpm"
62     "riece-command-join.xpm"
63     "riece-command-part.xpm"))
64
65 (defvar riece-scripts
66   '("server.rb"
67     "aproxy.rb"))
68
69 (defun riece-compile-modules (modules)
70   (let ((load-path (cons nil load-path))
71         error-modules)
72     (while modules
73       (let ((source (expand-file-name
74                      (concat (symbol-name (car modules)) ".el"))))
75         (if (file-newer-than-file-p source (concat source "c"))
76             (condition-case error
77                 (byte-compile-file source)
78               (error
79                (setq error-modules (cons (car modules) error-modules))))))
80       (setq modules (cdr modules)))
81     (if error-modules
82         (princ (concat "\n\
83   WARNING: ---------------------------------------------------------
84   WARNING: Couldn't compile following modules:
85   WARNING: 
86   WARNING:   " (mapconcat #'symbol-name error-modules ", ") "\n\
87   WARNING: 
88   WARNING: You should probably stop here, try \"make distclean\" to clear
89   WARNING: the last build, and then reconfigure.
90   WARNING: ---------------------------------------------------------\n\n")))))
91
92 (defun riece-compile-module ()
93   (let ((load-path (cons nil load-path)))
94     (let ((source (expand-file-name
95                    (concat (car command-line-args-left) ".el"))))
96       (if (file-newer-than-file-p source (concat source "c"))
97           (byte-compile-file source)))))
98
99 (defun riece-install-modules (modules dest just-print)
100   (unless (or just-print (file-exists-p dest))
101     (make-directory dest t))
102   (while modules
103     (let ((name (symbol-name (car modules))))
104       (princ (format "%s.el -> %s\n" name dest))
105       (unless just-print
106         (copy-file (expand-file-name (concat name ".el"))
107                    (expand-file-name (concat name ".el") dest)
108                    t t))
109       (princ (format "%s.elc -> %s\n" name dest))
110       (unless just-print
111         (if (file-exists-p (expand-file-name (concat name ".elc")))
112             (copy-file (expand-file-name (concat name ".elc"))
113                        (expand-file-name (concat name ".elc") dest)
114                        t t)
115           (princ (format "(%s was not successfully compiled, ignored)\n"
116                          name)))))
117     (setq modules (cdr modules))))
118
119 (defun riece-install-icons (icons dest just-print)
120   (unless (or just-print (file-exists-p dest))
121     (make-directory dest t))
122   (while icons
123     (when (file-exists-p (expand-file-name (car icons)))
124       (princ (format "%s -> %s\n" (car icons) dest))
125       (unless just-print
126         (copy-file (expand-file-name (car icons))
127                    (expand-file-name (car icons) dest)
128                    t t)))
129     (setq icons (cdr icons))))
130
131 (defun riece-install-scripts (scripts dest just-print)
132   (unless (or just-print (file-exists-p dest))
133     (make-directory dest t))
134   (while scripts
135     (when (file-exists-p (expand-file-name (car scripts)))
136       (princ (format "%s -> %s\n" (car scripts) dest))
137       (unless just-print
138         (copy-file (expand-file-name (car scripts))
139                    (expand-file-name (car scripts) dest)
140                    t t)))
141     (setq scripts (cdr scripts))))
142
143 (defun riece-install-just-print-p ()
144   (let ((flag (getenv "MAKEFLAGS"))
145         case-fold-search)
146     (if flag
147         (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
148
149 (defun riece-examine-modules ()
150   (let ((load-path (cons nil load-path)))
151     (require 'riece-mcat)
152     (require 'riece-addon-modules)
153     (append riece-modules
154             riece-mcat-modules
155             (mapcar #'car riece-addon-modules))))
156
157 (defun riece-examine ()
158   (princ (mapconcat #'symbol-name (riece-examine-modules) " ")))
159
160 (defun riece-update-mcat ()
161   (let ((modules (riece-examine-modules))
162         (pointer riece-mcat-modules)
163         files)
164     (while pointer
165       (setq modules (delq (car pointer) modules)
166             pointer (cdr pointer)))
167     (setq files (mapcar (lambda (module)
168                           (concat (symbol-name module) ".el"))
169                         modules)
170           pointer riece-mcat-modules)
171     (while pointer
172       (riece-mcat-update files (concat (symbol-name (car pointer)) ".el")
173                          (intern (concat (symbol-name (car pointer))
174                                          "-alist")))
175       (setq pointer (cdr pointer)))))
176
177 (defun riece-compile ()
178   (riece-compile-modules (riece-examine-modules)))
179
180 (defun riece-install ()
181   (riece-install-modules
182    (riece-examine-modules)
183    (expand-file-name "riece" (car command-line-args-left))
184    (riece-install-just-print-p))
185   (riece-install-icons
186    riece-icons
187    (expand-file-name "riece" (car command-line-args-left))
188    (riece-install-just-print-p))
189   (riece-install-scripts
190    riece-scripts
191    (expand-file-name "riece" (car command-line-args-left))
192    (riece-install-just-print-p))
193   ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
194   ;; attempts to open <arg1> as a file after <func>).
195   (setq command-line-args-left (cdr command-line-args-left)))
196
197 (defun riece-compile-package ()
198   (setq autoload-package-name "riece")
199   (add-to-list 'command-line-args-left ".")
200   (batch-update-directory)
201   (add-to-list 'command-line-args-left ".")
202   (Custom-make-dependencies)
203   (riece-compile-modules
204    (append (riece-examine-modules)
205            '(auto-autoloads custom-load))))
206
207 (defun riece-install-package ()
208   (riece-install-modules
209    (append (riece-examine-modules)
210            '(auto-autoloads custom-load))
211    (expand-file-name "lisp/riece" (car command-line-args-left))
212    (riece-install-just-print-p))
213   (riece-install-icons
214    riece-icons
215    (expand-file-name "etc/riece" (car command-line-args-left))
216    (riece-install-just-print-p))
217   (riece-install-scripts
218    riece-scripts
219    (expand-file-name "etc/riece" (car command-line-args-left))
220    (riece-install-just-print-p)))
221
222 (defun riece-test ()
223   (let ((load-path (cons (expand-file-name "test") (cons nil load-path)))
224         (files (directory-files "test" t "^test-.*\\.el$"))
225         suite)
226     (require 'lunit-report)
227     (setq suite (lunit-make-test-suite))
228     (while files
229       (when (file-regular-p (car files))
230         (load-file (car files))
231         (lunit-test-suite-add-test
232          suite
233          (lunit-make-test-suite-from-class
234           (intern (file-name-sans-extension
235                    (file-name-nondirectory (car files)))))))
236       (setq files (cdr files)))
237     (lunit-report suite (car command-line-args-left))))