mk-tm

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