mk-tm

   1 ;;; -*-Emacs-Lisp-*-
   2 ;;;
   3 ;;; $Id: mk-tm,v 7.6 1995/12/25 05:33:36 morioka Exp morioka $
   4 ;;;
   5
   6 (setq load-path (append
   7                  (mapcar (function
   8                           (lambda (path)
   9                             (expand-file-name path (getenv "PWD"))
  10                             ))
  11                          '("." "../tl/" "../mel/")
  12                          )
  13                  load-path))
  14
  15 (require 'tl-misc)
  16
  17 ;; Please specify VM path.
  18 (add-path "vm-5.95beta/")
  19
  20 ;; Please specify Mailcrypt path.
  21 (add-path "mailcrypt-3.4/")
  22
  23 (setq tm-modules
  24       (cons
  25        (cond ((boundp 'NEMACS)
  26               "tm-nemacs"
  27               )
  28              ((boundp 'MULE)
  29               "tm-mule"
  30               )
  31              (t
  32               "tm-orig"
  33               ))
  34        '("signature"
  35          "tm-def"
  36          "tm-ew-d" "tm-parse" "tm-view" "tm-play" "tm-partial"
  37          "tm-rich"
  38          "tm-latex" "tm-html" "tm-tar" "tm-file"
  39          "tm-ew-e"
  40          "tm-edit"
  41          "tm-rmail" "tm-mail"
  42          "tm-setup" "mime-setup"
  43          )))
  44
  45 (setq tm-uncompile-el-files '("sc-setup.el"))
  46
  47 (if (catch 'tag
  48       (let ((paths load-path) path)
  49         (while paths
  50           (setq path (expand-file-name "ange-ftp.el" (car paths)))
  51           (if (file-exists-p path)
  52               (throw 'tag path)
  53             )
  54           (setq paths (cdr paths))
  55           )))
  56     (setq tm-modules (append tm-modules '("tm-ftp")))
  57   (setq tm-uncompile-el-files
  58         (append tm-uncompile-el-files '("tm-ftp.el")))
  59   )
  60
  61 (if (catch 'tag
  62       (let ((paths load-path) path)
  63         (while paths
  64           (setq path (expand-file-name "vm.elc" (car paths)))
  65           (if (file-exists-p path)
  66               (throw 'tag path)
  67             )
  68           (setq paths (cdr paths))
  69           )))
  70     (setq tm-modules (append tm-modules '("tm-vm")))
  71   (setq tm-uncompile-el-files
  72         (append tm-uncompile-el-files '("tm-vm.el")))
  73   )
  74
  75 (if (catch 'tag
  76       (let ((paths load-path) path)
  77         (while paths
  78           (setq path (expand-file-name "mailcrypt.el" (car paths)))
  79           (if (file-exists-p path)
  80               (throw 'tag path)
  81             )
  82           (setq paths (cdr paths))
  83           )))
  84     (setq tm-modules (append tm-modules '("tm-pgp")))
  85   (setq tm-uncompile-el-files
  86         (append tm-uncompile-el-files '("tm-pgp.el")))
  87   )
  88
  89 (if (and (file-exists-p "tm-evs.el")
  90          (or (boundp 'MULE)
  91              (boundp 'NEMACS))
  92          )
  93     (setq tm-modules (append tm-modules '("tm-evs")))
  94   )
  95
  96 (if (string-match "XEmacs" emacs-version)
  97     (setq tm-modules (append tm-modules '("tm-image")))
  98   )
  99
 100 (setq tm-el-files
 101       (mapcar (function (lambda (module)
 102                           (concat module ".el")
 103                           ))
 104               tm-modules))
 105
 106 (setq tm-elc-files
 107       (mapcar (function (lambda (module)
 108                           (concat module ".elc")
 109                           ))
 110               tm-modules))
 111
 112 (defun compile-tm ()
 113   ;; (require 'gnus)
 114   (require 'tm-rich)
 115   (require 'mel-u)
 116   (require 'tm-edit)
 117   (load "rmailsum")
 118   (mapcar (function
 119            (lambda (module)
 120              (let ((el-file (concat module ".el"))
 121                    (elc-file (concat module ".elc"))
 122                    )
 123                (if (file-newer-than-file-p el-file elc-file)
 124                    (byte-compile-file el-file)
 125                  )
 126                )))
 127           tm-modules)
 128   )
 129
 130 (defconst el-file-mode (+ (* 64 6)(* 8 4) 4))
 131
 132 (defun install-el (path file)
 133   (let ((full-path (expand-file-name file path)))
 134     (if (file-exists-p full-path)
 135         (set-file-modes full-path el-file-mode)
 136       )
 137     (copy-file file full-path t t)
 138     (princ (format "%s -> %s\n" file path))
 139     ))
 140
 141 (defun install-el-files (path &rest files)
 142   (mapcar (function (lambda (file)
 143                       (if (file-exists-p file)
 144                           (install-el path file)
 145                         )))
 146           files))
 147
 148 (defun install-elc (path file)
 149   (let ((full-path (expand-file-name file path)))
 150     (copy-file file full-path t t)
 151     (delete-file file)
 152     (princ (format "%s -> %s\n" file path))
 153     ))
 154
 155 (defun install-elc-files (path &rest files)
 156   (mapcar (function (lambda (file)
 157                       (if (file-exists-p file)
 158                           (install-elc path file)
 159                         )))
 160           files))
 161
 162 (defun install-tm ()
 163   (let ((path (car command-line-args-left)))
 164     (princ (format "%s\n" emacs-version))
 165     (if (not (file-exists-p path))
 166         (make-directory path t)
 167       )
 168     (apply (function install-el-files) path
 169            (append tm-el-files tm-uncompile-el-files)
 170            )
 171     (apply (function install-elc-files) path tm-elc-files)
 172     (setq command-line-args-left (cdr command-line-args-left))
 173     ))