Sync with apel-10_3-1.
authortomo <tomo>
Tue, 14 May 2002 12:33:57 +0000 (12:33 +0000)
committertomo <tomo>
Tue, 14 May 2002 12:33:57 +0000 (12:33 +0000)
emacs-lisp/alist.el
emacs-lisp/broken.el
emacs-lisp/install.el
emacs-lisp/path-util.el

index 4b656de..c1f1c94 100644 (file)
@@ -1,6 +1,6 @@
 ;;; alist.el --- utility functions for association list
 
 ;;; alist.el --- utility functions for association list
 
-;; Copyright (C) 1993,1994,1995,1996,1998,2000 Free Software Foundation, Inc.
+;; Copyright (C) 1993,94,95,96,97,98,99,2000 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: alist
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: alist
@@ -40,19 +40,10 @@ return a new alist whose car is the new pair and cdr is ALIST."
 (defun del-alist (key alist)
   "Delete an element whose car equals KEY from ALIST.
 Return the modified ALIST."
 (defun del-alist (key alist)
   "Delete an element whose car equals KEY from ALIST.
 Return the modified ALIST."
-  (if (equal key (car (car alist)))
-      (cdr alist)
-    (let ((pr alist)
-         (r (cdr alist)))
-      (catch 'tag
-       (while (not (null r))
-         (if (equal key (car (car r)))
-             (progn
-               (rplacd pr (cdr r))
-               (throw 'tag alist)))
-         (setq pr r)
-         (setq r (cdr r)))
-       alist))))
+  (let ((pair (assoc key alist)))
+    (if pair
+       (delq pair alist)
+      alist)))
 
 ;;;###autoload
 (defun set-alist (symbol key value)
 
 ;;;###autoload
 (defun set-alist (symbol key value)
index d30d97c..be4deb7 100644 (file)
@@ -1,8 +1,8 @@
-;;; broken.el --- Emacs broken facility infomation registry.
+;;; broken.el --- Emacs broken facility information registry.
 
 
-;; Copyright (C) 1998, 1999 Tanaka Akira <akr@jaist.ac.jp>
+;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
 
 
-;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Author: Tanaka Akira <akr@m17n.org>
 ;; Keywords: emulation, compatibility, incompatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
 ;; Keywords: emulation, compatibility, incompatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -55,7 +55,7 @@ ASSERTION is evaluated statically.
 
 FACILITY must be symbol.
 
 
 FACILITY must be symbol.
 
-If ASSERTION is not ommited and evaluated to nil and NO-NOTICE is nil,
+If ASSERTION is not omitted and evaluated to nil and NO-NOTICE is nil,
 it is noticed."
   (` (static-if (, assertion)
         (eval-and-compile
 it is noticed."
   (` (static-if (, assertion)
         (eval-and-compile
index eb20781..7938d8a 100644 (file)
@@ -1,8 +1,8 @@
 ;;; install.el --- Emacs Lisp package install utility
 
 ;;; install.el --- Emacs Lisp package install utility
 
-;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99,2000,01,02 Free Software Foundation, Inc.
 
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1996/08/18
 ;; Keywords: install, byte-compile, directory detection
 
 ;; Created: 1996/08/18
 ;; Keywords: install, byte-compile, directory detection
 
@@ -62,6 +62,7 @@
            (if (and (file-exists-p full-path) overwrite)
                (delete-file full-path))
            (copy-file src-file full-path t t)
            (if (and (file-exists-p full-path) overwrite)
                (delete-file full-path))
            (copy-file src-file full-path t t)
+           (set-file-modes full-path install-overwritten-file-modes)
            (if move
                (catch 'tag
                  (while (and (file-exists-p src-file)
            (if move
                (catch 'tag
                  (while (and (file-exists-p src-file)
@@ -74,7 +75,8 @@
            (princ (format "%s -> %s\n" file dest)))))))
 
 (defun install-files (files src dest &optional move overwrite just-print)
            (princ (format "%s -> %s\n" file dest)))))))
 
 (defun install-files (files src dest &optional move overwrite just-print)
-  (or (file-exists-p dest)
+  (or just-print
+      (file-exists-p dest)
       (make-directory dest t))
   (mapcar
    (function
       (make-directory dest t))
   (mapcar
    (function
            (if (file-exists-p full-path)
                (delete-file full-path))
            (copy-file src-file full-path t t)
            (if (file-exists-p full-path)
                (delete-file full-path))
            (copy-file src-file full-path t t)
+           (set-file-modes full-path install-overwritten-file-modes)
            (princ (format "%s -> %s\n" el-file dest)))))
       (setq src-file (expand-file-name elc-file src))
       (if (not (file-exists-p src-file))
            (princ (format "%s -> %s\n" el-file dest)))))
       (setq src-file (expand-file-name elc-file src))
       (if (not (file-exists-p src-file))
             (if (file-exists-p full-path)
                 (delete-file full-path))
            (copy-file src-file full-path t t)
             (if (file-exists-p full-path)
                 (delete-file full-path))
            (copy-file src-file full-path t t)
+           (set-file-modes full-path install-overwritten-file-modes)
            (catch 'tag
              (while (file-exists-p src-file)
                (condition-case err
            (catch 'tag
              (while (file-exists-p src-file)
                (condition-case err
            (princ (format "%s -> %s\n" elc-file dest))))))))
 
 (defun install-elisp-modules (modules src dest &optional just-print)
            (princ (format "%s -> %s\n" elc-file dest))))))))
 
 (defun install-elisp-modules (modules src dest &optional just-print)
-  (or (file-exists-p dest)
+  (or just-print
+      (file-exists-p dest)
       (make-directory dest t))
   (mapcar
    (function
       (make-directory dest t))
   (mapcar
    (function
   (install-detect-elisp-directory))
 
 
   (install-detect-elisp-directory))
 
 
+;;; @ for XEmacs package system
+;;;
+
+;; (defun install-update-package-files (package dir &optional just-print)
+;;   (cond
+;;    (just-print
+;;     (princ (format "Updating autoloads in directory %s..\n\n" dir))
+;; 
+;;     (princ (format "Processing %s\n" dir))
+;;     (princ "Generating custom-load.el...\n\n")
+;; 
+;;     (princ (format "Compiling %s...\n"
+;;                    (expand-file-name "auto-autoloads.el" dir)))
+;;     (princ (format "Wrote %s\n"
+;;                    (expand-file-name "auto-autoloads.elc" dir)))
+;; 
+;;     (princ (format "Compiling %s...\n"
+;;                    (expand-file-name "custom-load.el" dir)))
+;;     (princ (format "Wrote %s\n"
+;;                    (expand-file-name "custom-load.elc" dir))))
+;;    (t
+;;     (setq autoload-package-name package)
+;; 
+;;     (let ((command-line-args-left (list dir)))
+;;       (batch-update-directory))
+;; 
+;;     (let ((command-line-args-left (list dir)))
+;;       (Custom-make-dependencies))
+;; 
+;;     (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
+;;     (byte-compile-file (expand-file-name "custom-load.el" dir)))))
+
+
+;;; @ Other Utilities
+;;;
+
+(defun install-just-print-p ()
+  (let ((flag (getenv "MAKEFLAGS"))
+       (case-fold-search nil))
+    (princ (format "%s\n" flag))
+    (if flag
+       (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
+
+
 ;;; @ end
 ;;;
 
 ;;; @ end
 ;;;
 
index 385aecd..034fd17 100644 (file)
@@ -1,6 +1,6 @@
 ;;; path-util.el --- Emacs Lisp file detection utility
 
 ;;; path-util.el --- Emacs Lisp file detection utility
 
-;; Copyright (C) 1996,1997,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1996,1997,1999,2000,2002 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: file detection, install, module
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: file detection, install, module
@@ -24,6 +24,8 @@
 
 ;;; Code:
 
 
 ;;; Code:
 
+;; (require 'poe)
+
 (defvar default-load-path load-path
   "*Base of `load-path'.
 It is used as default value of target path to search file or
 (defvar default-load-path load-path
   "*Base of `load-path'.
 It is used as default value of target path to search file or
@@ -36,7 +38,7 @@ directories and it does not exist in `load-path'.
 
 You can use following PATH styles:
        load-path relative: \"PATH/\"
 
 You can use following PATH styles:
        load-path relative: \"PATH/\"
-                       (it is searched from `defaul-load-path')
+                       (it is searched from `default-load-path')
        home directory relative: \"~/PATH/\" \"~USER/PATH/\"
        absolute path: \"/HOO/BAR/BAZ/\"
 
        home directory relative: \"~/PATH/\" \"~USER/PATH/\"
        absolute path: \"/HOO/BAR/BAZ/\"
 
@@ -52,18 +54,16 @@ You can specify following OPTIONS:
               (while rest
                 (setq p (expand-file-name path (car rest)))
                 (if (file-directory-p p)
               (while rest
                 (setq p (expand-file-name path (car rest)))
                 (if (file-directory-p p)
-                    (throw 'tag p)
-                  )
-                (setq rest (cdr rest))
-                ))
-            (not (member p load-path))
-            )
+                    (throw 'tag p))
+                (setq rest (cdr rest))))
+            (not (or (member p load-path)
+                     (if (string-match "/$" p)
+                         (member (substring p 0 (1- (length p))) load-path)
+                       (member (file-name-as-directory p) load-path)))))
        (setq load-path
              (if (memq 'append options)
                  (append load-path (list p))
        (setq load-path
              (if (memq 'append options)
                  (append load-path (list p))
-               (cons p load-path)
-               ))
-      )))
+               (cons p load-path))))))
 
 ;;;###autoload
 (defun add-latest-path (pattern &optional all-paths)
 
 ;;;###autoload
 (defun add-latest-path (pattern &optional all-paths)