mk-tm

   1 ;;; -*-Emacs-Lisp-*-
   2 ;;;
   3 ;;; $Id: mk-tm,v 7.1 1995/11/16 15:44:45 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       (append
  22        (cons
  23         (cond ((boundp 'NEMACS)
  24                "tm-nemacs"
  25                )
  26               ((boundp 'MULE)
  27                "tm-mule"
  28                )
  29               (t
  30                "tm-orig"
  31                ))
  32         '("signature"
  33           "tm-def"
  34           "tm-ew-d" "tm-ew-e" "tm-eword"
  35           "tm-parse" "tm-view" "tm-play" "tm-partial"
  36           "tm-latex" "tm-html" "tm-tar" "tm-file"
  37           "tm-rmail" "tm-edit"
  38           "tm-setup" "mime-setup"
  39           ))
  40        (cons
  41         (if (or (< emacs-major-version 19)(< emacs-minor-version 29))
  42             "tinyrich"
  43           "richtext"
  44           )
  45         '("tm-rich")
  46         )
  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 (and (file-exists-p "tm-evs.el")
  80          (or (boundp 'MULE)
  81              (boundp 'NEMACS))
  82          )
  83     (setq tm-modules (append tm-modules '("tm-evs")))
  84   )
  85
  86 (setq tm-el-files
  87       (mapcar (function (lambda (module)
  88                           (concat module ".el")
  89                           ))
  90               tm-modules))
  91
  92 (setq tm-elc-files
  93       (mapcar (function (lambda (module)
  94                           (concat module ".elc")
  95                           ))
  96               tm-modules))
  97
  98 (defun compile-tm ()
  99   (require 'gnus)
 100   (require 'tm-rich)
 101   (require 'mel-u)
 102   (require 'tm-edit)
 103   (mapcar (function byte-compile-file file) tm-el-files)
 104   )
 105
 106 (defconst el-file-mode (+ (* 64 6)(* 8 4) 4))
 107
 108 (defun install-el (path file)
 109   (let ((full-path (expand-file-name file path)))
 110     (if (file-exists-p full-path)
 111         (set-file-modes full-path el-file-mode)
 112       )
 113     (copy-file file full-path t t)
 114     (princ (format "%s -> %s\n" file path))
 115     ))
 116
 117 (defun install-el-files (path &rest files)
 118   (mapcar (function (lambda (file)
 119                       (if (file-exists-p file)
 120                           (install-el path file)
 121                         )))
 122           files))
 123
 124 (defun install-elc (path file)
 125   (let ((full-path (expand-file-name file path)))
 126     (copy-file file full-path t t)
 127     (delete-file file)
 128     (princ (format "%s -> %s\n" file path))
 129     ))
 130
 131 (defun install-elc-files (path &rest files)
 132   (mapcar (function (lambda (file)
 133                       (if (file-exists-p file)
 134                           (install-elc path file)
 135                         )))
 136           files))
 137
 138 (defun install-tm ()
 139   (let ((path (car command-line-args-left)))
 140     (princ (format "%s\n" emacs-version))
 141     (if (not (file-exists-p path))
 142         (make-directory path t)
 143       )
 144     (apply (function install-el-files) path
 145            (append tm-el-files tm-uncompile-el-files)
 146            )
 147     (apply (function install-elc-files) path tm-elc-files)
 148     ))