X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fapel.git;a=blobdiff_plain;f=install.el;h=2d9dd411323f3673f60cda24f50f8a2864c407f9;hp=1aa56a34d94b6131dbceb1b61f6d7940169146d3;hb=ad3ba73586a7e06f1311726585c1e2c86995bda2;hpb=dbd26211b662539d07b22bdf43f3cb33eec010db diff --git a/install.el b/install.el index 1aa56a3..2d9dd41 100644 --- a/install.el +++ b/install.el @@ -25,53 +25,8 @@ ;;; Code: -;; 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))) +(require 'poe) ; make-directory for v18 +(require 'path-util) ; default-load-path ;;; @ compile Emacs Lisp files @@ -86,16 +41,17 @@ to create parent directories if they don't exist." (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))) - modules)) + (mapcar + (function + (lambda (module) + (compile-elisp-module module path every-time))) + modules)) ;;; @ install files ;;; -(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) +(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) ; 0644 (defun install-file (file src dest &optional move overwrite just-print) (if just-print @@ -120,10 +76,11 @@ to create parent directories if they don't exist." (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))) - files)) + (mapcar + (function + (lambda (file) + (install-file file src dest move overwrite just-print))) + files)) ;;; @@ install Emacs Lisp files @@ -165,10 +122,11 @@ to create parent directories if they don't exist." (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))) - modules)) + (mapcar + (function + (lambda (module) + (install-elisp-module module src dest just-print))) + modules)) ;;; @ detect install path @@ -176,8 +134,8 @@ to create parent directories if they don't exist." ;; install to shared directory (maybe "/usr/local") (defvar install-prefix - (if (or (<= emacs-major-version 18) ; running-emacs-18 - (featurep 'xemacs) ; running-xemacs + (if (or (<= emacs-major-version 18) + (featurep 'xemacs) (and (boundp 'system-configuration-options) ; 19.29 or later (string= system-configuration-options "NT"))) ; for Meadow (expand-file-name "../../.." exec-directory) @@ -186,6 +144,7 @@ to create parent directories if they don't exist." (defvar install-elisp-prefix (if (>= emacs-major-version 19) "site-lisp" + ;; v18 does not have standard site directory. "local.lisp")) (defun install-detect-elisp-directory (&optional prefix elisp-prefix @@ -194,38 +153,39 @@ to create parent directories if they don't exist." (setq prefix install-prefix)) (or 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) - "/?$"))) - (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) - (car rest)))) - (throw 'tag (car rest)))) - (setq rest (cdr rest))))) - (expand-file-name (concat - (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/") - ((featurep 'xemacs) ; running-xemacs - (if (featurep 'mule) - "xmule/" - "xemacs/")) - (t "emacs/")) - elisp-prefix) - prefix))) + (or (catch 'tag + (let ((rest default-load-path) + (regexp (concat "^" + (expand-file-name (concat ".*/" elisp-prefix) + prefix) + "/?$"))) + (while rest + (if (string-match regexp (car rest)) + (if (or allow-version-specific + (not (string-match (format "/%d\\.%d" + emacs-major-version + emacs-minor-version) + (car rest)))) + (throw 'tag (car rest)))) + (setq rest (cdr rest))))) + (expand-file-name (concat (if (and (not (featurep 'xemacs)) + (or (>= emacs-major-version 20) + (and (= emacs-major-version 19) + (> emacs-minor-version 28)))) + "share/" + "lib/") + (cond + ((featurep 'xemacs) + (if (featurep 'mule) + "xmule/" + "xemacs/")) + ;; unfortunately, unofficial mule based on + ;; 19.29 and later use "emacs/" by default. + ((boundp 'MULE) "mule/") + ((boundp 'NEMACS) "nemacs/") + (t "emacs/")) + elisp-prefix) + prefix))) (defvar install-default-elisp-directory (install-detect-elisp-directory))