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? \e$B$+$i\e(B \\([0-9.]*\\) \e$B$X$NJQ99E@\e(B")))
  42 (defconst wl-news-filename "wl-news.el")
  43
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 \f
  46 (require 'cl)
  47 (defvar INFODIR nil)
  48
  49 (condition-case () (require 'custom) (error nil))
  50 ;; for wl-vars.el
  51 (unless (and (fboundp 'defgroup)
  52              (fboundp 'defcustom)
  53              ;; ignore broken module
  54              (not (featurep 'tinycustom)))
  55   (when (and (boundp 'emacs-major-version)
  56              (= emacs-major-version 19)
  57              (>= emacs-minor-version 29))
  58     (message "%s" "
  59   Warning: You don't seem to have \"new custom\" package installed.
  60            See README file of APEL package for more information.
  61 "))
  62   (require 'backquote)
  63   (defmacro defgroup (&rest args))
  64   (defmacro defcustom (symbol value &optional doc &rest args)
  65     (let ((doc (concat "*" (or doc ""))))
  66       (` (defvar (, symbol) (, value) (, doc))))))
  67
  68 (load "bytecomp" nil t)
  69
  70 (unless (fboundp 'byte-compile-file-form-custom-declare-variable)
  71   ;; Bind defcustom'ed variables.
  72   (put 'custom-declare-variable 'byte-hunk-handler
  73        'byte-compile-file-form-custom-declare-variable)
  74   (defun byte-compile-file-form-custom-declare-variable (form)
  75     (if (memq 'free-vars byte-compile-warnings)
  76         (setq byte-compile-bound-variables
  77               (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
  78     form))
  79
  80 (condition-case nil
  81     (char-after)
  82   (wrong-number-of-arguments
  83    ;; Optimize byte code for `char-after'.
  84    (put 'char-after 'byte-optimizer 'byte-optimize-char-after)
  85    (defun byte-optimize-char-after (form)
  86      (if (null (cdr form))
  87          '(char-after (point))
  88        form))))
  89
  90 (setq byte-compile-warnings '(free-vars unresolved callargs redefine))
  91
  92 ;; v18, v19
  93 (if (boundp 'MULE)
  94     (setq max-lisp-eval-depth 400))
  95
  96 ;; FIXME: it is currently needed to byte-compile with Emacs 21.
  97 (setq recursive-load-depth-limit nil)
  98
  99 (condition-case () (require 'easymenu) (error nil))
 100
 101 (defvar config-wl-package-done nil)
 102
 103 (defun config-wl-package-subr ()
 104   (unless config-wl-package-done
 105     (setq config-wl-package-done t)
 106     (setq load-path (cons (expand-file-name ".") load-path))
 107     (setq load-path (cons (expand-file-name WLDIR)
 108                           (cons (expand-file-name ELMODIR) load-path)))
 109     ;; load custom file if exists.  `WL-CFG.el' override for committer.
 110     (load "./WL-CFG" t nil nil)
 111     ;; load-path
 112     (if wl-install-utils
 113         (setq load-path (cons (expand-file-name UTILSDIR) load-path)))
 114     (require 'install)
 115     (load "./WL-ELS" nil nil t)
 116     ;; product.el version check
 117     (require 'product)
 118     (if (not (fboundp 'product-version-as-string))
 119         (error "Please install new APEL.  See INSTALL or INSTALL.ja"))
 120     ;; smtp.el version check.
 121     (require 'smtp)
 122     (if (not (fboundp 'smtp-send-buffer))
 123         (error "Please install new FLIM.  See INSTALL or INSTALL.ja"))
 124     (condition-case ()
 125         (require 'mime-setup)
 126       (error (error "Cannot load `mime-setup'.  Please install SEMI")))))
 127
 128 (defun config-wl-pixmap-dir (&optional packagedir)
 129   "Examine pixmap directory where icon files should go."
 130   (let ((pixmap-dir (car command-line-args-left)))
 131     (defvar PIXMAPDIR
 132       (if (string= pixmap-dir "NONE")
 133           (if packagedir
 134               (expand-file-name "etc/wl/" packagedir)
 135             (expand-file-name "wl/icons/" data-directory))
 136         pixmap-dir)))
 137   (if PIXMAPDIR
 138       (princ (format "PIXMAPDIR is %s\n" PIXMAPDIR)))
 139   (setq command-line-args-left (cdr command-line-args-left)))
 140
 141 (defun config-wl-package ()
 142   (config-wl-package-subr)
 143   ;; LISPDIR check.
 144   (let ((elispdir (car command-line-args-left)))
 145     (if (string= elispdir "NONE")
 146         (defvar LISPDIR (install-detect-elisp-directory))
 147       (defvar LISPDIR elispdir)))
 148   (princ (format "LISPDIR is %s\n" LISPDIR))
 149   (setq command-line-args-left (cdr command-line-args-left))
 150   ;; PIXMAPDIR check.
 151   (config-wl-pixmap-dir)
 152   (princ "\n"))
 153
 154 (defun update-version ()
 155   "Update version number of documents."
 156   (config-wl-package)
 157   (load-file "elmo/elmo-version.el")
 158   (let ((version (mapconcat
 159                   'number-to-string
 160                   (product-version (product-find 'elmo-version))
 161                   "."))
 162         (coding-system-for-write 'iso-latin-1-unix))
 163     (princ (concat "Update version number to " version "\n"))
 164     ;; generate version.tex
 165     (with-temp-buffer
 166       (insert "\\def\\versionnumber{" version "}\n")
 167       (write-region (point-min) (point-max) (expand-file-name
 168                                              "version.tex" "doc")))
 169     ;; generate version.texi
 170     (with-temp-buffer
 171       (insert "@set VERSION " version "\n")
 172       (write-region (point-min) (point-max) (expand-file-name
 173                                              "version.texi" "doc")))))
 174
 175 (defun test-wl ()
 176   "Run test suite for developer."
 177   (config-wl-package)
 178   (make-wl-news)
 179   (require 'lunit)
 180   (let ((files (directory-files "tests" t "^test-.*\\.el$"))
 181         (suite (lunit-make-test-suite)))
 182     (while files
 183       (if (file-regular-p (car files))
 184           (progn
 185             (load-file (car files))
 186             (lunit-test-suite-add-test
 187              suite (lunit-make-test-suite-from-class
 188                     (intern (file-name-sans-extension
 189                              (file-name-nondirectory (car files))))))))
 190       (setq files (cdr files)))
 191     (lunit suite)))
 192
 193 (defun check-wl ()
 194   "Check user environment.  Not for developer."
 195   (config-wl-package)
 196   ;; Avoid load error
 197   (provide 'wl-news)
 198   (load "wl-news.el.in")
 199   (require 'lunit)
 200   (let ((files (directory-files "tests" t "^check-.*\\.el$"))
 201         (suite (lunit-make-test-suite)))
 202     (while files
 203       (if (file-regular-p (car files))
 204           (progn
 205             (load-file (car files))
 206             (lunit-test-suite-add-test
 207              suite (lunit-make-test-suite-from-class
 208                     (intern (file-name-sans-extension
 209                              (file-name-nondirectory (car files))))))))
 210       (setq files (cdr files)))
 211     (lunit suite)))
 212
 213 (defun wl-scan-source (path)
 214   (let (ret)
 215     (mapcar
 216      '(lambda (x)
 217         (mapcar '(lambda (y)
 218                    (setq ret (append (list y (concat y "c")) ret)))
 219                 (directory-files x nil "\\(.+\\)\\.el$" t)))
 220      path)
 221     ret))
 222
 223
 224 (defun wl-uninstall (objs path)
 225   ;(message (mapconcat 'identity objs " "))
 226   (mapcar
 227    '(lambda (x)
 228       (let ((filename (expand-file-name x path)))
 229         (if (and (file-exists-p filename)
 230                  (file-writable-p filename))
 231             (progn
 232               (princ (format "%s was uninstalled.\n" filename))
 233               (delete-file filename)))))
 234    objs))
 235
 236
 237 (defun wl-examine-modules ()
 238   "Examine wl modules should be byte-compile'd."
 239   (config-wl-package-subr)
 240   (make-wl-news)
 241   (dolist (module modules-alist)
 242     (dolist (filename (cdr module))
 243       (princ (format "%s/%s.elc " (car module) filename)))))
 244
 245
 246 (defun compile-wl-package ()
 247   (config-wl-package)
 248   (make-wl-news)
 249   (mapcar
 250    '(lambda (x)
 251       (compile-elisp-modules (cdr x) (car x)))
 252    modules-alist))
 253
 254 (defun install-wl-icons ()
 255   (if (not (file-directory-p PIXMAPDIR))
 256       (make-directory PIXMAPDIR t))
 257   (let* ((case-fold-search t)
 258          (icons (directory-files ICONDIR nil
 259                                  (cond ((featurep 'xemacs)
 260                                         "\\.x[bp]m$")
 261                                        ((and (boundp 'emacs-major-version)
 262                                              (>= emacs-major-version 21))
 263                                         "\\.img$\\|\\.x[bp]m$")
 264                                        ((featurep 'mule)
 265                                         "\\.img$\\|\\.xbm$")))))
 266     (install-files icons ICONDIR PIXMAPDIR nil 'overwrite)))
 267
 268 (defun install-wl-package ()
 269   (compile-wl-package)
 270   (let ((wl-install-dir (expand-file-name WL_PREFIX LISPDIR))
 271         (elmo-install-dir (expand-file-name ELMO_PREFIX LISPDIR)))
 272     (mapcar
 273      '(lambda (x)
 274         (install-elisp-modules (cdr x) (car x)
 275                                (if (string= (car x) ELMODIR)
 276                                    elmo-install-dir
 277                                  wl-install-dir)))
 278      modules-alist))
 279   (if PIXMAPDIR
 280       (install-wl-icons)))
 281
 282
 283 (defun uninstall-wl-package ()
 284   (config-wl-package)
 285   (let ((wl-install-dir (expand-file-name WL_PREFIX
 286                                           LISPDIR))
 287         (elmo-install-dir (expand-file-name ELMO_PREFIX
 288                                             LISPDIR)))
 289     (wl-uninstall (wl-scan-source (list WLDIR UTILSDIR))
 290                   wl-install-dir)
 291     (wl-uninstall (wl-scan-source (list ELMODIR))
 292                   elmo-install-dir))
 293   (if PIXMAPDIR
 294       (let* ((case-fold-search t)
 295              (icons (directory-files PIXMAPDIR t "\\.x[bp]m$"))
 296              icon)
 297         (while icons
 298           (setq icon (car icons)
 299                 icons (cdr icons))
 300           (if (and (file-exists-p icon)
 301                    (file-writable-p icon))
 302               (progn
 303                 (princ (format "%s was uninstalled.\n" icon))
 304                 (delete-file icon)))))))
 305
 306
 307 (defun config-wl-package-xmas ()
 308   (if (not (featurep 'xemacs))
 309       (error "This directive is only for XEmacs"))
 310   (config-wl-package-subr)
 311   ;; PACKAGEDIR check.
 312   (let (package-dir)
 313     (and (setq package-dir (car command-line-args-left))
 314          (if (string= "NONE" package-dir)
 315              (defvar PACKAGEDIR
 316                (if (boundp 'early-packages)
 317                    (let ((dirs (append (if early-package-load-path
 318                                            early-packages)
 319                                        (if late-package-load-path
 320                                            late-packages)
 321                                        (if last-package-load-path
 322                                            last-packages)))
 323                          dir)
 324                      (while (not (file-exists-p
 325                                   (setq dir (car dirs))))
 326                        (setq dirs (cdr dirs)))
 327                      dir)))
 328            (defvar PACKAGEDIR package-dir)))
 329     (princ (format "PACKAGEDIR is %s\n" PACKAGEDIR))
 330     (setq command-line-args-left (cdr command-line-args-left)))
 331   ;; PIXMAPDIR check.
 332   (config-wl-pixmap-dir PACKAGEDIR)
 333   (princ "\n"))
 334
 335 ;; from SEMI-MK
 336 (defun compile-wl-package-xmas ()
 337   (config-wl-package-xmas)
 338   (make-wl-news)
 339   (setq autoload-package-name "wl")
 340   (add-to-list 'command-line-args-left WLDIR)
 341   (batch-update-directory)
 342   (add-to-list 'command-line-args-left WLDIR)
 343   (Custom-make-dependencies)
 344   ;; WL-AUTOLOAD-MODULES
 345   (compile-elisp-modules WL-AUTOLOAD-MODULES WLDIR)
 346   (mapcar
 347    '(lambda (x)
 348       (compile-elisp-modules (cdr x) (car x)))
 349    modules-alist))
 350
 351 (defun install-wl-package-xmas ()
 352   (compile-wl-package-xmas)
 353   (let ((LISPDIR (expand-file-name "wl"
 354                                     (expand-file-name "lisp"
 355                                                       PACKAGEDIR)))
 356         (DATADIR  (expand-file-name "wl"
 357                                     (expand-file-name "etc"
 358                                                       PACKAGEDIR)))
 359         (INFODIR  (expand-file-name "info" PACKAGEDIR)))
 360     (or (file-exists-p DATADIR)
 361         (make-directory DATADIR t))
 362     (or (file-exists-p INFODIR)
 363         (make-directory INFODIR t))
 364     ;; copy xpm files
 365     (install-wl-icons)
 366
 367     (mapcar '(lambda (x)
 368                (install-elisp-modules (cdr x) (car x) LISPDIR))
 369             modules-alist)
 370     ;; WL-AUTOLOAD-MODULES
 371     (install-elisp-modules WL-AUTOLOAD-MODULES WLDIR LISPDIR)
 372     ;;
 373     (wl-texinfo-format)
 374     (wl-texinfo-install)))
 375
 376 \f
 377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 378 ;;; Texinfo stuff
 379
 380 (defun wl-texinfo-info-file (lang)
 381   (symbol-value (intern (format "wl-%s-info" lang))))
 382
 383 (defun wl-texinfo-texi-file (lang)
 384   (symbol-value (intern (format "wl-%s-texi" lang))))
 385
 386 (defun wl-texinfo-check-newer (lang)
 387   (let ((info-file (expand-file-name (wl-texinfo-info-file lang) DOCDIR)))
 388     (and
 389      (file-newer-than-file-p info-file
 390                              (expand-file-name "version.texi" DOCDIR))
 391      (file-newer-than-file-p info-file
 392                              (expand-file-name (wl-texinfo-texi-file lang) DOCDIR)))))
 393
 394 (defun wl-texinfo-format-file (lang)
 395   (require 'wl-vars) ;; for 'wl-cs-local
 396   (or (wl-texinfo-check-newer lang)
 397       (let (obuf)
 398         ;; Support old texinfmt.el
 399         (require 'ptexinfmt (expand-file-name "ptexinfmt.el" UTILSDIR))
 400         (find-file (expand-file-name (wl-texinfo-texi-file lang) DOCDIR))
 401         (setq obuf (current-buffer))
 402         ;; We can't know file names if splitted.
 403         (texinfo-format-buffer t)
 404         ;; Emacs20.2's default is 'raw-text-unix.
 405         (and (fboundp 'set-buffer-file-coding-system)
 406              (set-buffer-file-coding-system wl-cs-local))
 407         (save-buffer)
 408         (kill-buffer (current-buffer)) ;; info
 409         (kill-buffer obuf)) ;; texi
 410       ))
 411
 412 (defun wl-texinfo-format ()
 413   (wl-detect-info-directory)
 414   (cond ((null wl-info-lang))
 415         ((listp wl-info-lang)
 416          (mapcar 'wl-texinfo-format-file wl-info-lang))
 417         ((stringp wl-info-lang)
 418          (wl-texinfo-format-file wl-info-lang))))
 419
 420 (defun wl-texinfo-install-file (lang)
 421   (let ((infofile (wl-texinfo-info-file lang)))
 422     (install-file infofile DOCDIR INFODIR nil 'overwrite)))
 423
 424 (defun wl-texinfo-install ()
 425   (cond ((null wl-info-lang))
 426         ((listp wl-info-lang)
 427          (mapcar 'wl-texinfo-install-file wl-info-lang))
 428         ((stringp wl-info-lang)
 429          (wl-texinfo-install-file wl-info-lang))))
 430
 431 (defun wl-primary-info-file ()
 432   "Get primary info file (for wl-detect-info-directory)."
 433   (cond ((null wl-info-lang))
 434         ((listp wl-info-lang)
 435          (let ((wl-info-lang (car wl-info-lang)))
 436            (wl-primary-info-file)))
 437         ((stringp wl-info-lang)
 438          (wl-texinfo-info-file wl-info-lang))))
 439
 440 (defun wl-detect-info-directory ()
 441   (config-wl-package-subr)
 442   ;; INFODIR check.
 443   (when wl-info-lang
 444     (require 'info)
 445     (if (fboundp 'info-initialize)
 446         (info-initialize))
 447     (unless INFODIR
 448       (let ((infodir (car command-line-args-left))
 449             (info (wl-primary-info-file))
 450             previous)
 451         (setq INFODIR
 452               (if (string= infodir "NONE")
 453                   (if (setq previous
 454                             (exec-installed-p info Info-directory-list
 455                                               COMPRESS-SUFFIX-LIST))
 456                       (directory-file-name (file-name-directory previous))
 457                     (car Info-directory-list))
 458                 infodir))
 459         (setq command-line-args-left (cdr command-line-args-left))))
 460     (princ (format "INFODIR is %s\n\n" INFODIR))))
 461
 462 (defun install-wl-info ()
 463   (wl-texinfo-format)
 464   (wl-texinfo-install))
 465
 466 \f
 467 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 468 ;;; wl-news stuff
 469
 470 (defun wl-news-news-file (lang)
 471   (cadr (assoc lang wl-news-news-file)))
 472
 473 (defun wl-news-check-newer (out-filename news-lang)
 474   (let ((lang news-lang)
 475         ret)
 476     (while (car lang)
 477       (if (file-newer-than-file-p
 478            (wl-news-news-file (car lang)) out-filename)
 479           (setq ret t))
 480       (setq lang (cdr lang)))
 481     ret))
 482
 483 (defun make-wl-news ()
 484   (let ((in-filename
 485          (expand-file-name (concat wl-news-filename ".in") WLDIR))
 486         (out-filename
 487          (expand-file-name wl-news-filename WLDIR))
 488         (wl-news-lang (if (listp wl-news-lang)
 489                           wl-news-lang
 490                         (list wl-news-lang))))
 491     (if (or (file-newer-than-file-p in-filename out-filename)
 492             (wl-news-check-newer out-filename wl-news-lang))
 493         (with-temp-buffer
 494           (save-excursion
 495             (insert-file-contents in-filename)
 496             (goto-char (point-min))
 497             (unless (re-search-forward "^;;; -\\*- news-list -\\*-" nil t)
 498               (error "Invalid wl-news.el.in"))
 499             (forward-line 2)
 500             (if wl-news-lang
 501                 (progn
 502                   (insert "(defconst wl-news-news-alist\n  '")
 503                   (let ((p (point)))
 504                     (prin1 (wl-news-parse-news wl-news-lang) (current-buffer))
 505                     (save-excursion
 506                       (narrow-to-region p (point))
 507                       (goto-char (1+ p))
 508                       (while (re-search-forward "^(" nil t)
 509                         (replace-match "\\\\(")) ; avoid font-lock confusion
 510                       (widen)))
 511                   (insert ")\n"))
 512               (insert "(defconst wl-news-news-alist nil)\n\n"))
 513             (let ((buffer-file-coding-system (mime-charset-to-coding-system 'x-ctext)))
 514               (write-region (point-min) (point-max) out-filename)))))))
 515
 516 (defun wl-news-parse-news (lang)
 517   (let (news-list)
 518   (while (car lang)
 519     (setq news-list (cons
 520                         (cons (car lang) (wl-news-parse-news-subr (car lang)))
 521                         news-list))
 522     (setq lang (cdr lang)))
 523   news-list))
 524
 525 (defun wl-news-parse-news-subr (lang)
 526   (let ((filename (wl-news-news-file lang))
 527         (reg (cadr (assoc lang wl-news-search-regexp)))
 528         news-list)
 529     (if (and filename reg)
 530         (with-temp-buffer
 531           (insert-file-contents filename)
 532           (while (re-search-forward reg nil t)
 533             (let ((beg (match-beginning 0))
 534                   (version-tmp (split-string (match-string 1) "\\."))
 535                   version news-string end)
 536               (while version-tmp
 537                 (setq version (append version (list (string-to-int (car version-tmp)))))
 538                 (setq version-tmp (cdr version-tmp)))
 539               (re-search-forward "^\\(\\* \\|\f\\)" nil t)
 540               (goto-char (- (match-beginning 0) 1))
 541               (setq end (point))
 542               (setq news-string (buffer-substring beg end))
 543               (setq news-list
 544                     (append news-list
 545                             (list (cons version news-string))))))))
 546     news-list))
 547
 548
 549 \f
 550 ;;; ToDo
 551 ;;; * MORE refine code (^_^;
 552
 553 ;;; End