cgit.sxemacs.org Git - riece/blob - 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-addon-modules
  16                 riece-addon
  17                 riece-ruby
  18                 riece-cache
  19
  20                 riece-mode
  21                 ;; riece-identity -+-> riece-channel
  22                 ;;                 +-> riece-user
  23                 riece-identity
  24                 riece-channel
  25                 riece-user
  26
  27                 riece-misc
  28                 riece-signal
  29
  30                 ;; riece-layout ---> riece-display
  31                 riece-layout
  32                 riece-display
  33                 riece-server
  34
  35                 ;; riece-channel -+-> riece-naming
  36                 ;; riece-user    -+
  37                 riece-naming
  38                 riece-message
  39
  40                 ;; riece-filter calls riece-{handle,000,200,300,400,500}
  41                 riece-filter
  42                 riece-handle
  43                 riece-000
  44                 riece-200
  45                 riece-300
  46                 riece-400
  47                 riece-500
  48
  49                 riece-commands
  50                 riece-irc
  51                 riece))))
  52
  53 (defvar riece-mcat-modules
  54   '(riece-mcat-japanese))
  55
  56 (defvar riece-generated-modules
  57   '(riece-package-info))
  58
  59 (defvar riece-icons
  60   '("riece-command-previous-channel.xpm"
  61     "riece-command-next-channel.xpm"
  62     "riece-command-configure-windows.xpm"
  63     "riece-command-list-addons.xpm"
  64     "riece-command-join.xpm"
  65     "riece-command-part.xpm"
  66     "riece-notify-icon.png"))
  67
  68 (defvar riece-scripts
  69   '("server.rb"
  70     "aproxy.rb"))
  71
  72 (defun riece-byte-compile-dest-file-function (filename)
  73   (expand-file-name
  74    (concat (file-name-nondirectory filename) "c")))
  75
  76 (defun riece-compile-modules (modules srcdir)
  77   (let ((load-path (cons nil (cons srcdir load-path)))
  78         error-modules)
  79     (while modules
  80       (let ((source (expand-file-name
  81                      (concat (symbol-name (car modules)) ".el")
  82                      srcdir))
  83             (binary (expand-file-name
  84                      (concat (symbol-name (car modules)) ".elc"))))
  85         (if (file-newer-than-file-p source binary)
  86             (condition-case error
  87                 (let ((byte-compile-dest-file-function
  88                        #'riece-byte-compile-dest-file-function))
  89                   (byte-compile-file source))
  90               (error
  91                (setq error-modules (cons (car modules) error-modules))))))
  92       (setq modules (cdr modules)))
  93     (if error-modules
  94         (princ (concat "\n\
  95   WARNING: ---------------------------------------------------------
  96   WARNING: Couldn't compile following modules:
  97   WARNING:
  98   WARNING:   " (mapconcat #'symbol-name error-modules ", ") "\n\
  99   WARNING:
 100   WARNING: You should probably stop here, try \"make distclean\" to clear
 101   WARNING: the last build, and then reconfigure.
 102   WARNING: ---------------------------------------------------------\n\n")))))
 103
 104 (defun riece-compile-module ()
 105   (let ((load-path (cons nil load-path)))
 106     (let ((source (expand-file-name
 107                    (concat (car command-line-args-left) ".el"))))
 108       (if (file-newer-than-file-p source (concat source "c"))
 109           (byte-compile-file source))))
 110   ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
 111   ;; attempts to open <arg1> as a file after <func>).
 112   (setq command-line-args-left (cdr command-line-args-left)))
 113
 114 (defun riece-install-modules (modules srcdir lispdir just-print)
 115   (unless (or just-print (file-exists-p lispdir))
 116     (make-directory lispdir t))
 117   ;; Workaround for "make distcheck"
 118   (set-file-modes lispdir 493)
 119   (while modules
 120     (let ((name (symbol-name (car modules))))
 121       (princ (format "%s.el -> %s\n" name lispdir))
 122       (unless just-print
 123         (copy-file (expand-file-name
 124                     (concat name ".el")
 125                     (if (memq (car modules) riece-generated-modules)
 126                         nil
 127                       srcdir))
 128                    (expand-file-name (concat name ".el") lispdir)
 129                    t t))
 130       (princ (format "%s.elc -> %s\n" name lispdir))
 131       (unless just-print
 132         (if (file-exists-p (expand-file-name (concat name ".elc")))
 133             (copy-file (expand-file-name (concat name ".elc"))
 134                        (expand-file-name (concat name ".elc") lispdir)
 135                        t t)
 136           (princ (format "(%s was not successfully compiled, ignored)\n"
 137                          name)))))
 138     (setq modules (cdr modules))))
 139
 140 (defun riece-install-icons (icons srcdir lispdir just-print)
 141   (unless (or just-print (file-exists-p lispdir))
 142     (make-directory lispdir t))
 143   ;; Workaround for "make distcheck"
 144   (set-file-modes lispdir 493)
 145   (while icons
 146     (when (file-exists-p (expand-file-name (car icons) srcdir))
 147       (princ (format "%s -> %s\n" (car icons) lispdir))
 148       (unless just-print
 149         (copy-file (expand-file-name (car icons) srcdir)
 150                    (expand-file-name (car icons) lispdir)
 151                    t t)))
 152     (setq icons (cdr icons))))
 153
 154 (defun riece-install-scripts (scripts srcdir lispdir just-print)
 155   (unless (or just-print (file-exists-p lispdir))
 156     (make-directory lispdir t))
 157   ;; Workaround for "make distcheck"
 158   (set-file-modes lispdir 493)
 159   (while scripts
 160     (when (file-exists-p (expand-file-name (car scripts) srcdir))
 161       (princ (format "%s -> %s\n" (car scripts) lispdir))
 162       (unless just-print
 163         (copy-file (expand-file-name (car scripts) srcdir)
 164                    (expand-file-name (car scripts) lispdir)
 165                    t t)))
 166     (setq scripts (cdr scripts))))
 167
 168 (defun riece-install-just-print-p ()
 169   (let ((flag (getenv "MAKEFLAGS"))
 170         case-fold-search)
 171     (if flag
 172         (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
 173
 174 (defun riece-examine-modules (srcdir)
 175   (let ((load-path (cons nil (cons srcdir load-path))))
 176     (require 'riece-mcat)
 177     (require 'riece-addon-modules)
 178     (append riece-modules
 179             riece-mcat-modules
 180             (mapcar #'car riece-addon-modules))))
 181
 182 (defun riece-examine ()
 183   (princ (mapconcat #'symbol-name
 184                     (riece-examine-modules (car command-line-args-left))
 185                     " ")))
 186
 187 (defun riece-update-mcat ()
 188   (let* ((srcdir (car command-line-args-left))
 189          (modules (riece-examine-modules srcdir))
 190          (pointer riece-mcat-modules)
 191          files)
 192     (while pointer
 193       (setq modules (delq (car pointer) modules)
 194             pointer (cdr pointer)))
 195     (setq files (mapcar (lambda (module)
 196                           (concat (symbol-name module) ".el"))
 197                         modules)
 198           pointer riece-mcat-modules)
 199     (while pointer
 200       (riece-mcat-update files (concat (symbol-name (car pointer)) ".el")
 201                          (intern (concat (symbol-name (car pointer))
 202                                          "-alist")))
 203       (setq pointer (cdr pointer))))
 204   ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
 205   ;; attempts to open <arg1> as a file after <func>).
 206   (setq command-line-args-left (cdr command-line-args-left)))
 207
 208 (defun riece-compile ()
 209   (let ((srcdir (car command-line-args-left)))
 210     (setq command-line-args-left (cdr command-line-args-left))
 211     (riece-compile-modules (riece-examine-modules srcdir) srcdir))
 212   ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
 213   ;; attempts to open <arg1> as a file after <func>).
 214   (setq command-line-args-left (cdr command-line-args-left)))
 215
 216 (defun riece-install ()
 217   (let ((srcdir (car command-line-args-left))
 218         (lispdir (nth 1 command-line-args-left)))
 219     (riece-install-modules
 220      (riece-examine-modules srcdir)
 221      srcdir
 222      (expand-file-name "riece" lispdir)
 223      (riece-install-just-print-p))
 224     (riece-install-icons
 225      riece-icons
 226      srcdir
 227      (expand-file-name "riece" lispdir)
 228      (riece-install-just-print-p))
 229     (riece-install-scripts
 230      riece-scripts
 231      srcdir
 232      (expand-file-name "riece" lispdir)
 233      (riece-install-just-print-p))
 234     ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
 235     ;; attempts to open <arg1> as a file after <func>).
 236     (setq command-line-args-left (nthcdr 2 command-line-args-left))))
 237
 238 (defun riece-uninstall ()
 239   (let ((files (directory-files (expand-file-name "riece"
 240                                                   (car command-line-args-left))
 241                                 t "\\.\\(elc?\\|rb\\|xpm\\)$")))
 242     (while files
 243       (delete-file (car files))
 244       (setq files (cdr files)))
 245     ;; Workaround for an XEmacs 21.5 bug ("xemacs -batch -f <func> <arg1>"
 246     ;; attempts to open <arg1> as a file after <func>).
 247     (setq command-line-args-left (cdr command-line-args-left))))
 248
 249 (defun riece-compile-package ()
 250   (let ((srcdir (car command-line-args-left)))
 251     (setq command-line-args-left (cdr command-line-args-left))
 252     (if (fboundp 'batch-update-directory-autoloads)
 253         (let ((command-line-args-left (list "riece" srcdir)))
 254           (batch-update-directory-autoloads))
 255       (let ((command-line-args-left (list srcdir)))
 256         (setq autoload-package-name "riece")
 257         (batch-update-autoloads)))
 258     (let ((command-line-args-left (list srcdir)))
 259       (Custom-make-dependencies))
 260     (riece-compile-modules
 261      (append (riece-examine-modules srcdir)
 262              '(auto-autoloads custom-load))
 263      srcdir)))
 264
 265 (defun riece-install-package ()
 266   (let ((srcdir (car command-line-args-left)))
 267     (setq command-line-args-left (cdr command-line-args-left))
 268     (riece-install-modules
 269      (append (riece-examine-modules srcdir)
 270              '(auto-autoloads custom-load))
 271      srcdir
 272      (expand-file-name "lisp/riece" (car command-line-args-left))
 273      (riece-install-just-print-p))
 274     (riece-install-icons
 275      riece-icons
 276      srcdir
 277      (expand-file-name "etc/riece" (car command-line-args-left))
 278      (riece-install-just-print-p))
 279     (riece-install-scripts
 280      riece-scripts
 281      srcdir
 282      (expand-file-name "etc/riece" (car command-line-args-left))
 283      (riece-install-just-print-p))))
 284
 285 (defun riece-test ()
 286   (let* ((srcdir (car command-line-args-left))
 287          (load-path (cons (expand-file-name "test" srcdir)
 288                           (cons srcdir (cons nil load-path))))
 289          (files (directory-files (expand-file-name "test" srcdir) t
 290                                  "^test-.*\\.el$"))
 291          suite)
 292     (require 'lunit-report)
 293     (setq suite (lunit-make-test-suite))
 294     (while files
 295       (when (file-regular-p (car files))
 296         (load-file (car files))
 297         (lunit-test-suite-add-test
 298          suite
 299          (lunit-make-test-suite-from-class
 300           (intern (file-name-sans-extension
 301                    (file-name-nondirectory (car files)))))))
 302       (setq files (cdr files)))
 303     (lunit-report suite (nth 1 command-line-args-left))))