From 256060ea8b8111748d0ef796f053c0f87fe88788 Mon Sep 17 00:00:00 2001 From: tomo Date: Tue, 14 May 2002 12:33:57 +0000 Subject: [PATCH] Sync with apel-10_3-1. --- emacs-lisp/alist.el | 19 +++++----------- emacs-lisp/broken.el | 8 +++---- emacs-lisp/install.el | 57 +++++++++++++++++++++++++++++++++++++++++++---- emacs-lisp/path-util.el | 22 +++++++++--------- 4 files changed, 73 insertions(+), 33 deletions(-) diff --git a/emacs-lisp/alist.el b/emacs-lisp/alist.el index 4b656de..c1f1c94 100644 --- a/emacs-lisp/alist.el +++ b/emacs-lisp/alist.el @@ -1,6 +1,6 @@ ;;; 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 ;; 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." - (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) diff --git a/emacs-lisp/broken.el b/emacs-lisp/broken.el index d30d97c..be4deb7 100644 --- a/emacs-lisp/broken.el +++ b/emacs-lisp/broken.el @@ -1,8 +1,8 @@ -;;; broken.el --- Emacs broken facility infomation registry. +;;; broken.el --- Emacs broken facility information registry. -;; Copyright (C) 1998, 1999 Tanaka Akira +;; Copyright (C) 1998,1999 Free Software Foundation, Inc. -;; Author: Tanaka Akira +;; Author: Tanaka Akira ;; 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. -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 diff --git a/emacs-lisp/install.el b/emacs-lisp/install.el index eb20781..7938d8a 100644 --- a/emacs-lisp/install.el +++ b/emacs-lisp/install.el @@ -1,8 +1,8 @@ ;;; 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 +;; Author: MORIOKA Tomohiko ;; 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) + (set-file-modes full-path install-overwritten-file-modes) (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) - (or (file-exists-p dest) + (or just-print + (file-exists-p dest) (make-directory dest t)) (mapcar (function @@ -100,6 +102,7 @@ (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)) @@ -110,6 +113,7 @@ (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 @@ -120,7 +124,8 @@ (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 @@ -191,6 +196,50 @@ (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 ;;; diff --git a/emacs-lisp/path-util.el b/emacs-lisp/path-util.el index 385aecd..034fd17 100644 --- a/emacs-lisp/path-util.el +++ b/emacs-lisp/path-util.el @@ -1,6 +1,6 @@ ;;; 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 ;; Keywords: file detection, install, module @@ -24,6 +24,8 @@ ;;; 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 @@ -36,7 +38,7 @@ directories and it does not exist in `load-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/\" @@ -52,18 +54,16 @@ You can specify following OPTIONS: (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)) - (cons p load-path) - )) - ))) + (cons p load-path)))))) ;;;###autoload (defun add-latest-path (pattern &optional all-paths) -- 1.7.10.4