mk-tm

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