X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=install.el;h=4ddd36cd928e205a91eba1a94327bd9c9a4e3bee;hb=882c3f5b4e801d410db2b1363746db20cc68ce21;hp=f2f131e0848a7c5c11a4c47da1fb45edcf8f36ce;hpb=e47c19a9f98b560818385fb4fd7dca6b14f36767;p=elisp%2Fapel.git diff --git a/install.el b/install.el index f2f131e..4ddd36c 100644 --- a/install.el +++ b/install.el @@ -25,8 +25,53 @@ ;;; Code: -(require 'emu) -(require 'path-util) +;; for historical reason, we do (require 'emu) in this file. +;; but you should do (require 'emu) explicitly if you use functions and/or +;; variables defined in emu module. +;;(require 'emu) +(require 'poe) ; emacs-major-version, emacs-minor-version +(require 'path-util) ; default-load-path + +;; verbatim copy of `defun-maybe' from poe.el, and +;; `make-directory-internal' and `make-directory' from poe-18.el +(defmacro defun-maybe (name &rest everything-else) + "Define NAME as a function if NAME is not defined. +See also the function `defun'." + (or (and (fboundp name) + (not (get name 'defun-maybe))) + (` (or (fboundp (quote (, name))) + (prog1 + (defun (, name) (,@ everything-else)) + (put (quote (, name)) 'defun-maybe t)))))) + +(defun-maybe make-directory-internal (dirname) + "Create a directory. One argument, a file name string." + (let ((dir (expand-file-name dirname))) + (if (file-exists-p dir) + (error "Creating directory: %s is already exist" dir) + (call-process "mkdir" nil nil nil dir)))) + +(defun-maybe make-directory (dir &optional parents) + "Create the directory DIR and any nonexistent parent dirs. +The second (optional) argument PARENTS says whether +to create parent directories if they don't exist." + (let ((len (length dir)) + (p 0) p1 path) + (catch 'tag + (while (and (< p len) (string-match "[^/]*/?" dir p)) + (setq p1 (match-end 0)) + (if (= p1 len) + (throw 'tag nil)) + (setq path (substring dir 0 p1)) + (if (not (file-directory-p path)) + (cond ((file-exists-p path) + (error "Creating directory: %s is not directory" path)) + ((null parents) + (error "Creating directory: %s is not exist" path)) + (t + (make-directory-internal path)))) + (setq p p1))) + (make-directory-internal dir))) ;;; @ compile Emacs Lisp files @@ -35,19 +80,15 @@ (defun compile-elisp-module (module &optional path every-time) (setq module (expand-file-name (symbol-name module) path)) (let ((el-file (concat module ".el")) - (elc-file (concat module ".elc")) - ) + (elc-file (concat module ".elc"))) (if (or every-time (file-newer-than-file-p el-file elc-file)) - (byte-compile-file el-file) - ) - )) + (byte-compile-file el-file)))) (defun compile-elisp-modules (modules &optional path every-time) (mapcar (function (lambda (module) - (compile-elisp-module module path every-time) - )) + (compile-elisp-module module path every-time))) modules)) @@ -63,8 +104,7 @@ (if (file-exists-p src-file) (let ((full-path (expand-file-name file dest))) (if (and (file-exists-p full-path) overwrite) - (delete-file full-path) - ) + (delete-file full-path)) (copy-file src-file full-path t t) (if move (catch 'tag @@ -73,21 +113,16 @@ (condition-case err (progn (delete-file src-file) - (throw 'tag nil) - ) - (error (princ (format "%s\n" (nth 1 err)))) - )))) - (princ (format "%s -> %s\n" file dest)) - )) - ))) + (throw 'tag nil)) + (error (princ (format "%s\n" (nth 1 err)))))))) + (princ (format "%s -> %s\n" file dest))))))) (defun install-files (files src dest &optional move overwrite just-print) (or (file-exists-p dest) - (make-directory dest t) - ) - (mapcar (function (lambda (file) - (install-file file src dest move overwrite just-print) - )) + (make-directory dest t)) + (mapcar (function + (lambda (file) + (install-file file src dest move overwrite just-print))) files)) @@ -98,8 +133,7 @@ (let (el-file elc-file) (let ((name (symbol-name module))) (setq el-file (concat name ".el")) - (setq elc-file (concat name ".elc")) - ) + (setq elc-file (concat name ".elc"))) (let ((src-file (expand-file-name el-file src))) (if (not (file-exists-p src-file)) nil @@ -107,11 +141,9 @@ (princ (format "%s -> %s\n" el-file dest)) (let ((full-path (expand-file-name el-file dest))) (if (file-exists-p full-path) - (delete-file full-path) - ) + (delete-file full-path)) (copy-file src-file full-path t t) - (princ (format "%s -> %s\n" el-file dest)) - ))) + (princ (format "%s -> %s\n" el-file dest))))) (setq src-file (expand-file-name elc-file src)) (if (not (file-exists-p src-file)) nil @@ -119,41 +151,37 @@ (princ (format "%s -> %s\n" elc-file dest)) (let ((full-path (expand-file-name elc-file dest))) (if (file-exists-p full-path) - (delete-file full-path) - ) + (delete-file full-path)) (copy-file src-file full-path t t) (catch 'tag (while (file-exists-p src-file) (condition-case err (progn (delete-file src-file) - (throw 'tag nil) - ) - (error (princ (format "%s\n" (nth 1 err)))) - ))) - (princ (format "%s -> %s\n" elc-file dest)) - ))) - ))) + (throw 'tag nil)) + (error (princ (format "%s\n" (nth 1 err))))))) + (princ (format "%s -> %s\n" elc-file dest)))))))) (defun install-elisp-modules (modules src dest &optional just-print) (or (file-exists-p dest) - (make-directory dest t) - ) - (mapcar (function (lambda (module) - (install-elisp-module module src dest just-print) - )) + (make-directory dest t)) + (mapcar (function + (lambda (module) + (install-elisp-module module src dest just-print))) modules)) ;;; @ detect install path ;;; +;; install to shared directory (maybe "/usr/local") (defvar install-prefix - (if (or running-emacs-18 running-xemacs - (string= system-configuration-options "NT")) ; for Meadow + (if (or (<= emacs-major-version 18) ; running-emacs-18 + (featurep 'xemacs) ; running-xemacs + (and (boundp 'system-configuration-options) ; 19.29 or later + (string= system-configuration-options "NT"))) ; for Meadow (expand-file-name "../../.." exec-directory) - (expand-file-name "../../../.." data-directory) - )) ; install to shared directory (maybe "/usr/local") + (expand-file-name "../../../.." data-directory))) (defvar install-elisp-prefix (if (>= emacs-major-version 19) @@ -163,42 +191,41 @@ (defun install-detect-elisp-directory (&optional prefix elisp-prefix allow-version-specific) (or prefix - (setq prefix install-prefix) - ) + (setq prefix install-prefix)) (or elisp-prefix - (setq elisp-prefix install-elisp-prefix) - ) + (setq elisp-prefix install-elisp-prefix)) (or (catch 'tag (let ((rest default-load-path) (pat (concat "^" (expand-file-name (concat ".*/" elisp-prefix) prefix) - "/?$")) - dir) - (while (setq dir (car rest)) - (if (string-match pat dir) + "/?$"))) + (while rest + (if (string-match pat (car rest)) (if (or allow-version-specific (not (string-match (format "/%d\\.%d" emacs-major-version - emacs-minor-version) dir)) - ) - (throw 'tag dir) - )) - (setq rest (cdr rest)) - ))) + emacs-minor-version) + (car rest)))) + (throw 'tag (car rest)))) + (setq rest (cdr rest))))) (expand-file-name (concat - (if running-emacs-19_29-or-later + (if (and ; running-emacs-19_29-or-later + (not (featurep 'xemacs)) + (or (>= emacs-major-version 20) + (and (= emacs-major-version 19) + (>= emacs-minor-version 29)))) "share/" "lib/") (cond ((boundp 'NEMACS) "nemacs/") ((boundp 'MULE) "mule/") - (running-xemacs + ((featurep 'xemacs) ; running-xemacs (if (featurep 'mule) "xmule/" "xemacs/")) (t "emacs/")) - elisp-prefix) prefix) - )) + elisp-prefix) + prefix))) (defvar install-default-elisp-directory (install-detect-elisp-directory))