mk-tm

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