WL-MK

   1 ;;; -*- Emacs-Lisp -*-
   2 ;;; WL-MK for byte-compile, install, uninstall
   3 ;;;
   4 ;;; Original by OKUNISHI Fujikazu <fuji0924@mbox.kyoto-inet.or.jp>
   5 ;;; Modified by Yuuichi Teranishi <teranisi@gohome.org>
   6
   7 ;;;;;;;;;;;;;;;;;;;;;   DO NOT EDIT THIS FILE   ;;;;;;;;;;;;;;;;;;;;;
   8 ;;;;;;;;;;;;;;;;;;;;;     INTERNAL USE ONLY     ;;;;;;;;;;;;;;;;;;;;;
   9
  10 ;;; Code
  11
  12 (defvar WLDIR "./wl")
  13 (defvar ELMODIR "./elmo")
  14 (defvar DOCDIR "./doc")
  15 (defvar ICONDIR "./etc/icons")
  16 (defvar UTILSDIR "./utils")
  17 (defvar WL_PREFIX "wl")
  18 (defvar ELMO_PREFIX "wl")
  19
  20 (defvar COMPRESS-SUFFIX-LIST '("" ".gz" ".Z" ".bz2"))
  21
  22 (defvar wl-install-utils nil
  23   "If Non-nil, install `wl-utils-modules'.")
  24
  25 ;;; INFO
  26 (defconst wl-ja-info "wl-ja.info")
  27 (defconst wl-ja-texi "wl-ja.texi")
  28 (defconst wl-en-info "wl.info")
  29 (defconst wl-en-texi "wl.texi")
  30
  31 (defvar wl-info-lang (if (featurep 'mule) '("ja" "en") '("en"))
  32   "The language of info file (\"ja\" or \"en\").")
  33
  34 ;;; NEWS
  35 (defvar wl-news-lang (if (featurep 'mule) '("ja" "en") '("en"))
  36   "The language of news file (\"ja\" or \"en\").")
  37 (defconst wl-news-news-file '(("en" "NEWS")
  38                               ("ja" "NEWS.ja")))
  39 (defconst wl-news-search-regexp
  40   '(("en" "^\\* Changes in \\([0-9.]*\\) from [0-9.]+x?")
  41     ("ja" "^\\* [0-9.]+x? から \\([0-9.]*\\) への変更点")))
  42 (defconst wl-news-filename "wl-news.el")
  43
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 \f
  46 (defvar INFODIR nil)
  47
  48 (load "bytecomp" nil t)
  49
  50 (setq byte-compile-warnings '(free-vars unresolved callargs redefine))
  51
  52 (condition-case () (require 'easymenu) (error nil))
  53
  54 (defvar config-wl-package-done nil)
  55
  56 (defun config-wl-package-subr-1 ()
  57   (unless config-wl-package-done
  58     (setq load-path (cons (expand-file-name ".") load-path))
  59     (setq load-path (cons (expand-file-name WLDIR)
  60                           (cons (expand-file-name ELMODIR) load-path)))
  61     ;; load custom file if exists.  `WL-CFG.el' override for committer.
  62     (load "./WL-CFG" t nil nil)
  63     ;; load-path
  64     (if wl-install-utils
  65         (setq load-path (cons (expand-file-name UTILSDIR) load-path)))))
  66
  67 (defun config-wl-package-subr-2 ()
  68   (unless config-wl-package-done
  69     (setq config-wl-package-done t)
  70     (require 'path-util)
  71     (load "./WL-ELS" nil nil t)
  72     ;; product.el version check
  73     (require 'product)
  74     (if (not (fboundp 'product-version-as-string))
  75         (error "Please install new APEL.  See INSTALL or INSTALL.ja"))
  76     ;; smtp.el version check.
  77     (require 'smtp)
  78     (if (not (fboundp 'smtp-send-buffer))
  79         (error "Please install new FLIM.  See INSTALL or INSTALL.ja"))
  80     (condition-case ()
  81         (require 'mime-setup)
  82       (error (error "Cannot load `mime-setup'.  Please install SEMI")))))
  83
  84 (defun config-wl-package-subr ()
  85   (config-wl-package-subr-1)
  86   (config-wl-package-subr-2))
  87
  88 (defun config-wl-pixmap-dir (&optional packagedir)
  89   "Examine pixmap directory where icon files should go."
  90   (let ((pixmap-dir (car command-line-args-left)))
  91     (defvar PIXMAPDIR
  92       (if (string= pixmap-dir "NONE")
  93           (if packagedir
  94               (expand-file-name "etc/wl/" packagedir)
  95             (expand-file-name "wl/icons/" data-directory))
  96         pixmap-dir)))
  97   (if PIXMAPDIR
  98       (princ (format "PIXMAPDIR is %s\n" PIXMAPDIR)))
  99   (setq command-line-args-left (cdr command-line-args-left)))
 100
 101 (defun config-wl-package ()
 102   (config-wl-package-subr-1)
 103   ;; LISPDIR check.
 104   (let ((elispdir (car command-line-args-left)))
 105     (setq command-line-args-left (cdr command-line-args-left))
 106     (when (setq package-lisp-dir (car command-line-args-left))
 107       (or (string-equal "NONE" package-lisp-dir)
 108           (progn
 109             (defvar PACKAGE_LISPDIR
 110               (if (boundp (intern package-lisp-dir))
 111                   (symbol-value (intern package-lisp-dir))
 112                 package-lisp-dir))
 113             (princ (format "PACKAGE_LISPDIR=%s\n"
 114                            PACKAGE_LISPDIR))
 115             (let ((default-directory PACKAGE_LISPDIR))
 116               (normal-top-level-add-subdirs-to-load-path)))))
 117     (require 'install)
 118     (if (string= elispdir "NONE")
 119         (defvar LISPDIR (install-detect-elisp-directory))
 120       (defvar LISPDIR elispdir)))
 121   (princ (format "LISPDIR is %s\n" LISPDIR))
 122   (setq command-line-args-left (cdr command-line-args-left))
 123   (config-wl-package-subr-2)
 124   ;; PIXMAPDIR check.
 125   (config-wl-pixmap-dir)
 126   (princ "\n"))
 127
 128 (defun update-version ()
 129   "Update version number of documents."
 130   (config-wl-package)
 131   (load-file "elmo/elmo-version.el")
 132   (let ((version (mapconcat
 133                   'number-to-string
 134                   (product-version (product-find 'elmo-version))
 135                   "."))
 136         (coding-system-for-write 'iso-latin-1-unix))
 137     (princ (concat "Update version number to " version "\n"))
 138     ;; generate version.tex
 139     (with-temp-buffer
 140       (insert "\\def\\versionnumber{" version "}\n")
 141       (write-region (point-min) (point-max) (expand-file-name
 142                                              "version.tex" "doc")))
 143     ;; generate version.texi
 144     (with-temp-buffer
 145       (insert "@set VERSION " version "\n")
 146       (write-region (point-min) (point-max) (expand-file-name
 147                                              "version.texi" "doc")))))
 148
 149 (defun test-wl ()
 150   "Run test suite for developer."
 151   (config-wl-package)
 152   (make-wl-news)
 153   (require 'lunit)
 154   (let ((files (directory-files "tests" t "^test-.*\\.el$"))
 155         (suite (lunit-make-test-suite)))
 156     (while files
 157       (if (file-regular-p (car files))
 158           (progn
 159             (load-file (car files))
 160             (lunit-test-suite-add-test
 161              suite (lunit-make-test-suite-from-class
 162                     (intern (file-name-sans-extension
 163                              (file-name-nondirectory (car files))))))))
 164       (setq files (cdr files)))
 165     (lunit suite)))
 166
 167 (defun check-wl ()
 168   "Check user environment.  Not for developer."
 169   (config-wl-package)
 170   ;; Avoid load error
 171   (provide 'wl-news)
 172   (load "wl-news.el.in")
 173   (require 'lunit)
 174   (let ((files (directory-files "tests" t "^check-.*\\.el$"))
 175         (suite (lunit-make-test-suite)))
 176     (while files
 177       (if (file-regular-p (car files))
 178           (progn
 179             (load-file (car files))
 180             (lunit-test-suite-add-test
 181              suite (lunit-make-test-suite-from-class
 182                     (intern (file-name-sans-extension
 183                              (file-name-nondirectory (car files))))))))
 184       (setq files (cdr files)))
 185     (lunit suite)))
 186
 187 (defun wl-scan-path (path scanner)
 188   (let ((dirs (if (listp path)
 189                   path
 190                 (list path))))
 191     (apply 'append (mapcar scanner dirs))))
 192
 193 (defun wl-scan-source (path)
 194   (wl-scan-path path
 195                 (lambda (x)
 196                   (apply 'append
 197                          (mapcar (lambda (y)
 198                                    (list y (concat y "c")))
 199                                  (directory-files x nil "\\(.+\\)\\.el$" t))))))
 200
 201 (defun wl-scan-icons (path)
 202   (wl-scan-path path
 203                 (lambda (x)
 204                   (let ((case-fold-search t))
 205                     (directory-files x nil "\\.x[bp]m$")))))
 206
 207 (defun wl-uninstall (objs path)
 208   ;(message (mapconcat 'identity objs " "))
 209   (mapc
 210    (lambda (x)
 211      (let ((filename (expand-file-name x path)))
 212        (if (and (file-exists-p filename)
 213                 (file-writable-p filename))
 214            (progn
 215              (princ (format "%s was uninstalled.\n" filename))
 216              (delete-file filename)))))
 217    objs))
 218
 219
 220 (defun wl-examine-modules ()
 221   "Examine wl modules should be byte-compile'd."
 222   (config-wl-package-subr)
 223   (make-wl-news)
 224   (dolist (module modules-alist)
 225     (dolist (filename (cdr module))
 226       (princ (format "%s/%s.elc " (car module) filename)))))
 227
 228
 229 (defun compile-wl-package ()
 230   ;; to avoid to read situation-examples-file at compile time.
 231   (setq mime-situation-examples-file nil)
 232   (config-wl-package)
 233   (make-wl-news)
 234   (mapc
 235    (lambda (x)
 236      (compile-elisp-modules (cdr x) (car x)))
 237    modules-alist))
 238
 239 (defun install-wl-icons ()
 240   (if (not (file-directory-p PIXMAPDIR))
 241       (make-directory PIXMAPDIR t))
 242   (let* ((case-fold-search t)
 243          (icons (directory-files ICONDIR nil "\\.x[bp]m$")))
 244     (install-files icons ICONDIR PIXMAPDIR nil 'overwrite)))
 245
 246 (defun uninstall-wl-icons ()
 247   (if (not (file-directory-p PIXMAPDIR))
 248       ()
 249     (wl-uninstall (wl-scan-icons PIXMAPDIR)
 250                   PIXMAPDIR)))
 251
 252 (defun install-wl-package ()
 253   (compile-wl-package)
 254   (let ((wl-install-dir (expand-file-name WL_PREFIX LISPDIR))
 255         (elmo-install-dir (expand-file-name ELMO_PREFIX LISPDIR)))
 256     (mapc
 257      (lambda (x)
 258        (install-elisp-modules (cdr x) (car x)
 259                               (if (string= (car x) ELMODIR)
 260                                   elmo-install-dir
 261                                 wl-install-dir)))
 262      modules-alist))
 263   (if PIXMAPDIR
 264       (install-wl-icons)))
 265
 266
 267 (defun uninstall-wl-package ()
 268   (config-wl-package)
 269   (let ((wl-install-dir (expand-file-name WL_PREFIX
 270                                           LISPDIR))
 271         (elmo-install-dir (expand-file-name ELMO_PREFIX
 272                                             LISPDIR)))
 273     (wl-uninstall (wl-scan-source (list WLDIR UTILSDIR))
 274                   wl-install-dir)
 275     (wl-uninstall (wl-scan-source (list ELMODIR))
 276                   elmo-install-dir))
 277   (if PIXMAPDIR
 278       (uninstall-wl-icons)))
 279
 280 \f
 281 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 282 ;;; Texinfo stuff
 283
 284 (defun wl-texinfo-info-file (lang)
 285   (symbol-value (intern (format "wl-%s-info" lang))))
 286
 287 (defun wl-texinfo-texi-file (lang)
 288   (symbol-value (intern (format "wl-%s-texi" lang))))
 289
 290 (defun wl-texinfo-check-newer (lang)
 291   (let ((info-file (expand-file-name (wl-texinfo-info-file lang) DOCDIR)))
 292     (and
 293      (file-newer-than-file-p info-file
 294                              (expand-file-name "version.texi" DOCDIR))
 295      (file-newer-than-file-p info-file
 296                              (expand-file-name (wl-texinfo-texi-file lang) DOCDIR)))))
 297
 298 (defun wl-texinfo-format-file (lang)
 299   (or (wl-texinfo-check-newer lang)
 300       (let (obuf)
 301         ;; Support old texinfmt.el
 302         (require 'ptexinfmt (expand-file-name "ptexinfmt.el" UTILSDIR))
 303         (find-file (expand-file-name (wl-texinfo-texi-file lang) DOCDIR))
 304         (setq obuf (current-buffer))
 305         ;; We can't know file names if splitted.
 306         (texinfo-format-buffer t)
 307         (set-buffer-file-coding-system 'utf-8)
 308         (save-buffer)
 309         (kill-buffer (current-buffer)) ;; info
 310         (kill-buffer obuf)) ;; texi
 311       ))
 312
 313 (defun wl-texinfo-format ()
 314   (wl-detect-info-directory)
 315   (cond ((null wl-info-lang))
 316         ((listp wl-info-lang)
 317          (mapc 'wl-texinfo-format-file wl-info-lang))
 318         ((stringp wl-info-lang)
 319          (wl-texinfo-format-file wl-info-lang))))
 320
 321 (defun wl-texinfo-install-file (lang)
 322   (let ((infofile (wl-texinfo-info-file lang)))
 323     (install-file infofile DOCDIR INFODIR nil 'overwrite)))
 324
 325 (defun wl-texinfo-install ()
 326   (require 'install)
 327   (cond ((null wl-info-lang))
 328         ((listp wl-info-lang)
 329          (mapc 'wl-texinfo-install-file wl-info-lang))
 330         ((stringp wl-info-lang)
 331          (wl-texinfo-install-file wl-info-lang))))
 332
 333 (defun wl-primary-info-file ()
 334   "Get primary info file (for wl-detect-info-directory)."
 335   (cond ((null wl-info-lang))
 336         ((listp wl-info-lang)
 337          (let ((wl-info-lang (car wl-info-lang)))
 338            (wl-primary-info-file)))
 339         ((stringp wl-info-lang)
 340          (wl-texinfo-info-file wl-info-lang))))
 341
 342 (defun wl-detect-info-directory ()
 343   (config-wl-package-subr)
 344   ;; INFODIR check.
 345   (when wl-info-lang
 346     (require 'info)
 347     (if (fboundp 'info-initialize)
 348         (info-initialize))
 349     (unless INFODIR
 350       (let ((infodir (car command-line-args-left))
 351             (info (wl-primary-info-file))
 352             previous)
 353         (setq INFODIR
 354               (if (string= infodir "NONE")
 355                   (if (setq previous
 356                             (exec-installed-p info Info-directory-list
 357                                               COMPRESS-SUFFIX-LIST))
 358                       (directory-file-name (file-name-directory previous))
 359                     (car Info-directory-list))
 360                 infodir))
 361         (setq command-line-args-left (cdr command-line-args-left))))
 362     (princ (format "INFODIR is %s\n\n" INFODIR))))
 363
 364 (defun install-wl-info ()
 365   (wl-texinfo-format)
 366   (wl-texinfo-install))
 367
 368 \f
 369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 370 ;;; wl-news stuff
 371
 372 (defun wl-news-news-file (lang)
 373   (cadr (assoc lang wl-news-news-file)))
 374
 375 (defun wl-news-check-newer (out-filename news-lang)
 376   (let ((lang news-lang)
 377         ret)
 378     (while (car lang)
 379       (if (file-newer-than-file-p
 380            (wl-news-news-file (car lang)) out-filename)
 381           (setq ret t))
 382       (setq lang (cdr lang)))
 383     ret))
 384
 385 (defun make-wl-news ()
 386   (let ((in-filename
 387          (expand-file-name (concat wl-news-filename ".in") WLDIR))
 388         (out-filename
 389          (expand-file-name wl-news-filename WLDIR))
 390         (wl-news-lang (if (listp wl-news-lang)
 391                           wl-news-lang
 392                         (list wl-news-lang))))
 393     (if (or (file-newer-than-file-p in-filename out-filename)
 394             (wl-news-check-newer out-filename wl-news-lang))
 395         (with-temp-buffer
 396           (save-excursion
 397             (insert-file-contents in-filename)
 398             (goto-char (point-min))
 399             (unless (re-search-forward "^;;; -\\*- news-list -\\*-" nil t)
 400               (error "Invalid wl-news.el.in"))
 401             (forward-line 2)
 402             (if wl-news-lang
 403                 (progn
 404                   (insert "(defconst wl-news-news-alist\n  '")
 405                   (prin1 (wl-news-parse-news wl-news-lang) (current-buffer))
 406                   (insert ")\n"))
 407               (insert "(defconst wl-news-news-alist nil)\n\n"))
 408             (let ((buffer-file-coding-system (mime-charset-to-coding-system 'x-ctext)))
 409               (write-region (point-min) (point-max) out-filename)))))))
 410
 411 (defun wl-news-parse-news (lang)
 412   (let (news-list)
 413   (while (car lang)
 414     (setq news-list (cons
 415                         (cons (car lang) (wl-news-parse-news-subr (car lang)))
 416                         news-list))
 417     (setq lang (cdr lang)))
 418   news-list))
 419
 420 (defun wl-news-parse-news-subr (lang)
 421   (let ((filename (wl-news-news-file lang))
 422         (reg (cadr (assoc lang wl-news-search-regexp)))
 423         news-list)
 424     (if (and filename reg)
 425         (with-temp-buffer
 426           (insert-file-contents filename)
 427           (while (re-search-forward reg nil t)
 428             (let ((beg (match-beginning 0))
 429                   (version-tmp (split-string (match-string 1) "\\."))
 430                   version news-string end)
 431               (while version-tmp
 432                 (setq version (append version (list (string-to-number (car version-tmp)))))
 433                 (setq version-tmp (cdr version-tmp)))
 434               (re-search-forward "^\\(\\* \\|\f\\)" nil t)
 435               (goto-char (- (match-beginning 0) 1))
 436               (setq end (point))
 437               (setq news-string (buffer-substring beg end))
 438               (setq news-list
 439                     (append news-list
 440                             (list (cons version news-string))))))))
 441     news-list))
 442
 443
 444 \f
 445 ;;; ToDo
 446 ;;; * MORE refine code (^_^;
 447
 448 ;;; End