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/" 'all-paths)
  19
  20 ;; Please specify Mailcrypt path.
  21 (add-path "mailcrypt-3.4/" 'all-paths)
  22
  23 ;; Please specify Mailcrypt path.
  24 (add-path "bbdb-1.50/" 'all-paths)
  25
  26
  27 (setq tm-modules
  28       (cons
  29        (cond ((boundp 'NEMACS)
  30               "tm-nemacs"
  31               )
  32              ((boundp 'MULE)
  33               "tm-mule"
  34               )
  35              (t
  36               "tm-orig"
  37               ))
  38        '("signature"
  39          "tm-def"
  40          "tm-ew-d" "tm-parse" "tm-view" "tm-play" "tm-partial"
  41          "tm-rich"
  42          "tm-latex" "tm-html" "tm-tar" "tm-file"
  43          "tm-ew-e"
  44          "tm-edit"
  45          "tm-rmail" "tm-mail"
  46          "tm-setup" "mime-setup"
  47          )))
  48
  49 (setq tm-uncompile-el-files '("sc-setup.el"))
  50
  51 (if (catch 'tag
  52       (let ((paths load-path) path)
  53         (while paths
  54           (setq path (expand-file-name "ange-ftp.el" (car paths)))
  55           (if (file-exists-p path)
  56               (throw 'tag path)
  57             )
  58           (setq paths (cdr paths))
  59           )))
  60     (setq tm-modules (append tm-modules '("tm-ftp")))
  61   (setq tm-uncompile-el-files
  62         (append tm-uncompile-el-files '("tm-ftp.el")))
  63   )
  64
  65 (if (catch 'tag
  66       (let ((paths load-path) path)
  67         (while paths
  68           (setq path (expand-file-name "vm.elc" (car paths)))
  69           (if (file-exists-p path)
  70               (throw 'tag path)
  71             )
  72           (setq paths (cdr paths))
  73           )))
  74     (setq tm-modules (append tm-modules '("tm-vm")))
  75   (setq tm-uncompile-el-files
  76         (append tm-uncompile-el-files '("tm-vm.el")))
  77   )
  78
  79 (if (catch 'tag
  80       (let ((paths load-path) path)
  81         (while paths
  82           (setq path (expand-file-name "mailcrypt.el" (car paths)))
  83           (if (file-exists-p path)
  84               (throw 'tag path)
  85             )
  86           (setq paths (cdr paths))
  87           )))
  88     (setq tm-modules (append tm-modules '("tm-pgp")))
  89   (setq tm-uncompile-el-files
  90         (append tm-uncompile-el-files '("tm-pgp.el")))
  91   )
  92
  93 (if (catch 'tag
  94       (let ((paths load-path) path)
  95         (while paths
  96           (setq path (expand-file-name "bbdb.el" (car paths)))
  97           (if (file-exists-p path)
  98               (throw 'tag path)
  99             )
 100           (setq paths (cdr paths))
 101           )))
 102     (setq tm-modules (append tm-modules '("tm-bbdb")))
 103   (setq tm-uncompile-el-files
 104         (append tm-uncompile-el-files '("tm-bbdb.el")))
 105   )
 106
 107 (if (and (file-exists-p "tm-evs.el")
 108          (or (boundp 'MULE)
 109              (boundp 'NEMACS))
 110          )
 111     (setq tm-modules (append tm-modules '("tm-evs")))
 112   )
 113
 114 (if (string-match "XEmacs" emacs-version)
 115     (setq tm-modules (append tm-modules '("tm-image")))
 116   (if (boundp 'MULE)
 117       (if (catch 'tag
 118             (let ((paths load-path) path)
 119               (while paths
 120                 (setq path (expand-file-name "bitmap.el" (car paths)))
 121                 (if (file-exists-p path)
 122                     (throw 'tag path)
 123                   )
 124                 (setq paths (cdr paths))
 125                 )))
 126           (setq tm-modules (append tm-modules '("tm-image")))
 127         (setq tm-uncompile-el-files
 128               (append tm-uncompile-el-files '("tm-image.el")))
 129         )))
 130
 131 (setq tm-el-files
 132       (mapcar (function (lambda (module)
 133                           (concat module ".el")
 134                           ))
 135               tm-modules))
 136
 137 (setq tm-elc-files
 138       (mapcar (function (lambda (module)
 139                           (concat module ".elc")
 140                           ))
 141               tm-modules))
 142
 143 (defun compile-tm ()
 144   ;; (require 'gnus)
 145   (require 'tm-rich)
 146   (require 'mel-u)
 147   (require 'tm-edit)
 148   (load "rmailsum")
 149   (mapcar (function
 150            (lambda (module)
 151              (let ((el-file (concat module ".el"))
 152                    (elc-file (concat module ".elc"))
 153                    )
 154                (if (file-newer-than-file-p el-file elc-file)
 155                    (byte-compile-file el-file)
 156                  )
 157                )))
 158           tm-modules)
 159   )
 160
 161 (defconst el-file-mode (+ (* 64 6)(* 8 4) 4))
 162
 163 (defun install-el (path file)
 164   (let ((full-path (expand-file-name file path)))
 165     (if (file-exists-p full-path)
 166         (set-file-modes full-path el-file-mode)
 167       )
 168     (copy-file file full-path t t)
 169     (princ (format "%s -> %s\n" file path))
 170     ))
 171
 172 (defun install-el-files (path &rest files)
 173   (mapcar (function (lambda (file)
 174                       (if (file-exists-p file)
 175                           (install-el path file)
 176                         )))
 177           files))
 178
 179 (defun install-elc (path file)
 180   (let ((full-path (expand-file-name file path)))
 181     (copy-file file full-path t t)
 182     (delete-file file)
 183     (princ (format "%s -> %s\n" file path))
 184     ))
 185
 186 (defun install-elc-files (path &rest files)
 187   (mapcar (function (lambda (file)
 188                       (if (file-exists-p file)
 189                           (install-elc path file)
 190                         )))
 191           files))
 192
 193 (defun install-tm ()
 194   (let ((path (car command-line-args-left)))
 195     (princ (format "%s\n" emacs-version))
 196     (if (not (file-exists-p path))
 197         (make-directory path t)
 198       )
 199     (apply (function install-el-files) path
 200            (append tm-el-files tm-uncompile-el-files)
 201            )
 202     (apply (function install-elc-files) path tm-elc-files)
 203     (setq command-line-args-left (cdr command-line-args-left))
 204     ))