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 SASLDIR "./utils/sasl/lisp")
  18 (defvar WL_PREFIX "wl")
  19 (defvar ELMO_PREFIX "wl")
  20
  21 (defvar COMPRESS-SUFFIX-LIST '("" ".gz" ".Z" ".bz2"))
  22
  23 (defvar wl-install-utils nil
  24   "if Non-nil, install `wl-utils-modules'.")
  25 (defvar wl-install-sasl nil
  26   "if Non-nil, install sasl utilities.")
  27
  28 ;;; INFO
  29 (defconst wl-ja-info "wl-ja.info")
  30 (defconst wl-ja-texi "wl-ja.texi")
  31 (defconst wl-en-info "wl.info")
  32 (defconst wl-en-texi "wl.texi")
  33
  34 (defvar wl-info-lang "ja"
  35   "The language of info file (\"ja\" or \"en\").")
  36
  37 ;; for Nemacs (dirty!)
  38 (or (fboundp 'file-executable-p)
  39     (fset 'file-executable-p 'file-exists-p))
  40
  41 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42 \f
  43 (require 'cl)
  44 (defvar INFODIR nil)
  45
  46 (condition-case () (require 'custom) (error nil))
  47 ;; for wl-vars.el
  48 (unless (and (fboundp 'defgroup)
  49              (fboundp 'defcustom)
  50              ;; ignore broken module
  51              (not (featurep 'tinycustom)))
  52   (when (and (boundp 'emacs-major-version)
  53              (eq emacs-major-version 19)
  54              (>= emacs-minor-version 29))
  55     (message "%s" "
  56   Warning: You don't seem to have \"new custom\" package installed.
  57   It is recommended to use \"new custom\" package if you are using
  58   old Emacs, such as Mule 2.3.
  59   Get it from http://www.dina.kvl.dk/~abraham/custom/ and then apply
  60   the patch which is included in README file of APEL package.
  61 "))
  62   (defmacro defgroup (&rest args))
  63   (defmacro defcustom (symbol value &optional doc &rest args)
  64     (let ((doc (concat "*" (or doc ""))))
  65       (` (defvar (, symbol) (, value) (, doc))))))
  66
  67 (require 'bytecomp)
  68 (unless (fboundp 'byte-compile-file-form-custom-declare-variable)
  69   ;; Bind defcustom'ed variables.
  70   (put 'custom-declare-variable 'byte-hunk-handler
  71        'byte-compile-file-form-custom-declare-variable)
  72   (defun byte-compile-file-form-custom-declare-variable (form)
  73     (if (memq 'free-vars byte-compile-warnings)
  74         (setq byte-compile-bound-variables
  75               (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
  76     form))
  77
  78 (setq byte-compile-warnings '(free-vars unresolved callargs redefine))
  79
  80 ;; v18, v19
  81 (if (or (boundp 'MULE)
  82         (fboundp 'nemacs-version))
  83     (setq max-lisp-eval-depth 400))
  84
  85 ;; FIXME: it is currently needed to byte-compile with Emacs 21.
  86 (setq recursive-load-depth-limit nil)
  87
  88 (condition-case () (require 'easymenu) (error nil))
  89
  90 (defvar config-wl-package-done nil)
  91
  92 (defun config-wl-package-subr ()
  93   (unless config-wl-package-done
  94   (setq config-wl-package-done t)
  95   (setq load-path (cons (expand-file-name ".") load-path))
  96   (setq load-path (cons (expand-file-name WLDIR)
  97                         (cons (expand-file-name ELMODIR) load-path)))
  98   (setq wl-icon-dir (expand-file-name ICONDIR))
  99 ;;; load custom file if exists.
 100   (load "./WL-CFG" t nil t)
 101 ;;; load-path
 102   (if wl-install-utils
 103       (setq load-path (cons (expand-file-name UTILSDIR) load-path)))
 104   (if wl-install-sasl
 105       (setq load-path (cons (expand-file-name SASLDIR) load-path)))
 106   (require 'install)
 107   (load "./WL-ELS")
 108   (condition-case ()
 109       (require 'mime-setup)
 110     (error (error "No MIME module was detected. Please install SEMI or tm.")))
 111   (if wl-use-semi
 112       (princ (concat "\nUse SEMI"
 113                      (if wl-use-luna " with LUNA\n" " without LUNA\n")))
 114     (princ "\nUse tm.\n"))))
 115
 116 (defun config-wl-pixmap-dir (&optional packagedir)
 117   "Examine pixmap directory where icon files should go."
 118   (let ((pixmap-dir (car command-line-args-left)))
 119     (defvar PIXMAPDIR
 120       (if (string= pixmap-dir "NONE")
 121           (if packagedir
 122               (expand-file-name "etc/wl/" packagedir)
 123             (if (or (featurep 'xemacs)
 124                     (and (boundp 'emacs-major-version)
 125                          (>= emacs-major-version 21)))
 126                 (expand-file-name "wl/icons/" data-directory)))
 127         pixmap-dir)))
 128   (if PIXMAPDIR
 129       (princ (format "PIXMAPDIR is %s\n" PIXMAPDIR)))
 130   (setq command-line-args-left (cdr command-line-args-left)))
 131
 132 (defun config-wl-package ()
 133   (config-wl-package-subr)
 134   ;; LISPDIR check.
 135   (let ((elispdir (car command-line-args-left)))
 136     (if (string= elispdir "NONE")
 137         (defvar LISPDIR (install-detect-elisp-directory))
 138       (defvar LISPDIR elispdir)))
 139   (princ (format "LISPDIR is %s\n" LISPDIR))
 140   (setq command-line-args-left (cdr command-line-args-left))
 141   ;; PIXMAPDIR check.
 142   (config-wl-pixmap-dir)
 143   (princ "\n"))
 144
 145
 146 (defun wl-scan-source (path)
 147   (let (ret)
 148     (mapcar
 149      '(lambda (x)
 150         (mapcar '(lambda (y)
 151                    (setq ret (append (list y (concat y "c")) ret)))
 152                 (directory-files x nil "\\(.+\\)\\.el$" t)))
 153      path)
 154     ret))
 155
 156
 157 (defun wl-uninstall (objs path)
 158   ;(message (mapconcat 'identity objs " "))
 159   (mapcar
 160    '(lambda (x)
 161       (let ((filename (expand-file-name x path)))
 162         (if (and (file-exists-p filename)
 163                  (file-writable-p filename))
 164             (progn
 165               (princ (format "%s was uninstalled.\n" filename))
 166               (delete-file filename)))))
 167    objs))
 168
 169
 170 (defun compile-wl-package ()
 171   ;; For nemacs byte compiler's strange behavior(?).
 172   (config-wl-package)
 173   (if (fboundp 'nemacs-version)
 174       (load (expand-file-name "wl.el" WLDIR)))
 175   (mapcar
 176    '(lambda (x)
 177       (compile-elisp-modules (cdr x) (car x)))
 178    modules-alist))
 179
 180 (defun install-wl-icons ()
 181   (if (not (file-directory-p PIXMAPDIR))
 182       (make-directory PIXMAPDIR t))
 183   (let* ((case-fold-search t)
 184          (icons (directory-files ICONDIR t "\\.x[bp]m$"))
 185          icon dest)
 186     (while icons
 187       (setq icon (car icons)
 188             icons (cdr icons)
 189             dest (expand-file-name (file-name-nondirectory icon) PIXMAPDIR))
 190       (princ (format "%s->%s\n" icon dest))
 191       (copy-file icon dest t))))
 192
 193 (defun install-wl-package ()
 194   (compile-wl-package)
 195   (let ((wl-install-dir (expand-file-name WL_PREFIX LISPDIR))
 196         (elmo-install-dir (expand-file-name ELMO_PREFIX LISPDIR)))
 197     (mapcar
 198      '(lambda (x)
 199         (install-elisp-modules (cdr x) (car x)
 200                                (if (string= (car x) ELMODIR)
 201                                    elmo-install-dir
 202                                  wl-install-dir)))
 203      modules-alist))
 204   (if PIXMAPDIR
 205       (install-wl-icons)))
 206
 207
 208 (defun uninstall-wl-package ()
 209   (config-wl-package)
 210   (let ((wl-install-dir (expand-file-name WL_PREFIX
 211                                           LISPDIR))
 212         (elmo-install-dir (expand-file-name ELMO_PREFIX
 213                                             LISPDIR)))
 214     (wl-uninstall (wl-scan-source (list WLDIR UTILSDIR SASLDIR))
 215                   wl-install-dir)
 216     (wl-uninstall (wl-scan-source (list ELMODIR))
 217                   elmo-install-dir))
 218   (if PIXMAPDIR
 219       (let* ((case-fold-search t)
 220              (icons (directory-files PIXMAPDIR t "\\.x[bp]m$"))
 221              icon)
 222         (while icons
 223           (setq icon (car icons)
 224                 icons (cdr icons))
 225           (if (and (file-exists-p icon)
 226                    (file-writable-p icon))
 227               (progn
 228                 (princ (format "%s was uninstalled.\n" icon))
 229                 (delete-file icon)))))))
 230
 231
 232 (defun config-wl-package-xmas ()
 233   (if (not (featurep 'xemacs))
 234       (error "This directive is only for XEmacs."))
 235   (config-wl-package-subr)
 236   ;; PACKAGEDIR check.
 237   (let (package-dir)
 238     (and (setq package-dir (car command-line-args-left))
 239          (if (string= "NONE" package-dir)
 240              (defvar PACKAGEDIR
 241                (if (boundp 'early-packages)
 242                    (let ((dirs (append (if early-package-load-path
 243                                            early-packages)
 244                                        (if late-package-load-path
 245                                            late-packages)
 246                                        (if last-package-load-path
 247                                            last-packages)))
 248                          dir)
 249                      (while (not (file-exists-p
 250                                   (setq dir (car dirs))))
 251                        (setq dirs (cdr dirs)))
 252                      dir)))
 253            (defvar PACKAGEDIR package-dir)))
 254     (princ (format "PACKAGEDIR is %s\n" PACKAGEDIR))
 255     (setq command-line-args-left (cdr command-line-args-left)))
 256   ;; PIXMAPDIR check.
 257   (config-wl-pixmap-dir PACKAGEDIR)
 258   (princ "\n"))
 259
 260 ;; from SEMI-MK
 261 (defun compile-wl-package-xmas ()
 262   (config-wl-package-xmas)
 263   (setq autoload-package-name "wl")
 264   (add-to-list 'command-line-args-left WLDIR)
 265   (batch-update-directory)
 266   (add-to-list 'command-line-args-left WLDIR)
 267   (Custom-make-dependencies)
 268   ;; WL-AUTOLOAD-MODULES
 269   (compile-elisp-modules WL-AUTOLOAD-MODULES WLDIR)
 270   (mapcar
 271    '(lambda (x)
 272       (compile-elisp-modules (cdr x) (car x)))
 273    modules-alist))
 274
 275 (defun install-wl-package-xmas ()
 276   (compile-wl-package-xmas)
 277   (let ((LISPDIR (expand-file-name "wl"
 278                                     (expand-file-name "lisp"
 279                                                       PACKAGEDIR)))
 280         (DATADIR  (expand-file-name "wl"
 281                                     (expand-file-name "etc"
 282                                                       PACKAGEDIR)))
 283         (INFODIR  (expand-file-name "info" PACKAGEDIR)))
 284     (or (file-exists-p DATADIR)
 285         (make-directory DATADIR t))
 286     (or (file-exists-p INFODIR)
 287         (make-directory INFODIR t))
 288     ;; copy xpm files
 289     (install-wl-icons)
 290
 291     (mapcar '(lambda (x)
 292              (install-elisp-modules (cdr x) (car x) LISPDIR))
 293                   modules-alist)
 294     ;; WL-AUTOLOAD-MODULES
 295     (install-elisp-modules WL-AUTOLOAD-MODULES WLDIR LISPDIR)
 296     ;;
 297     (wl-texinfo-format)
 298     (wl-texinfo-install)))
 299
 300 \f
 301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 302 ;;; Texinfo stuff
 303
 304 (defun wl-texinfo-format-file (lang)
 305   (let ((infofile (symbol-value (intern (format "wl-%s-info" lang))))
 306         (texifile (symbol-value (intern (format "wl-%s-texi" lang)))))
 307     (require 'wl-vars) ;; for 'wl-cs-local
 308     (or (file-newer-than-file-p (expand-file-name infofile DOCDIR)
 309                                 (expand-file-name texifile DOCDIR))
 310         (let (obuf beg)
 311           ;; Support old texinfmt.el
 312           (require 'ptexinfmt (expand-file-name "ptexinfmt.el" UTILSDIR))
 313           (find-file (expand-file-name texifile DOCDIR))
 314           (setq obuf (current-buffer))
 315           ;; We can't know file names if splitted.
 316           (texinfo-format-buffer t)
 317           ;; Emacs20.2's default is 'raw-text-unix.
 318           (and (fboundp 'set-buffer-file-coding-system)
 319                (set-buffer-file-coding-system wl-cs-local))
 320           (save-buffer)
 321           (kill-buffer (current-buffer)) ;; info
 322           (kill-buffer obuf)) ;; texi
 323         )))
 324
 325 (defun wl-texinfo-format ()
 326   (unless INFODIR
 327     (setq INFODIR (wl-detect-info-directory)))
 328   (cond ((listp wl-info-lang)
 329          (mapcar 'wl-texinfo-format-file wl-info-lang))
 330         ((stringp wl-info-lang)
 331          (wl-texinfo-format-file wl-info-lang))))
 332
 333 (defun wl-texinfo-install-file (lang)
 334   (let ((infofile (symbol-value (intern (format "wl-%s-info" lang)))))
 335     (install-file infofile DOCDIR INFODIR)))
 336
 337 (defun wl-texinfo-install ()
 338   (cond ((listp wl-info-lang)
 339          (mapcar 'wl-texinfo-install-file wl-info-lang))
 340         ((stringp wl-info-lang)
 341          (wl-texinfo-install-file wl-info-lang))))
 342
 343 (defun wl-primary-info-file ()
 344   "Get primary info file (for wl-detect-info-directory)."
 345   (cond
 346    ((listp wl-info-lang)
 347     (let ((wl-info-lang (car wl-info-lang)))
 348       (wl-primary-info-file)))
 349    ((stringp wl-info-lang)
 350     (symbol-value (intern (format "wl-%s-info" wl-info-lang))))))
 351
 352 (defun wl-detect-info-directory ()
 353   (config-wl-package-subr)
 354   (if (fboundp 'nemacs-version)
 355       (error "Cannot format info on Nemacs. Please use another formatter."))
 356   ;; INFODIR check.
 357   (require 'info)
 358   (let ((infodir (car command-line-args-left))
 359         (info (wl-primary-info-file))
 360         previous INFODIR)
 361     (setq INFODIR
 362           (if (string= infodir "NONE")
 363               (if (setq previous
 364                         (exec-installed-p info Info-directory-list
 365                                           COMPRESS-SUFFIX-LIST))
 366                   ;;(progn
 367                   ;;(condition-case nil (delete-file previous))
 368                   (directory-file-name (file-name-directory previous));)
 369                 (car Info-directory-list))
 370             infodir))
 371     (setq command-line-args-left (cdr command-line-args-left))
 372     (princ (format "INFODIR is %s\n\n" INFODIR))
 373     INFODIR))
 374
 375 (defun install-wl-info ()
 376   (wl-texinfo-format)
 377   (wl-texinfo-install))
 378
 379 \f
 380 ;;; ToDo
 381 ;;; * MORE refine code (^_^;
 382
 383 ;;; End