Commit 53c1fa0f authored by Dave Love's avatar Dave Love
Browse files

(feature-symbols, file-provides, file-requires): Use mapc.

(feature-file): Avoid calling symbol-name.  Doc fix.
(file-set-intersect, file-dependents): Use dolist, not mapcar.
(loadhist-hook-functions): Add mouse-position-function.
(unload-feature): Change uses of mapcar.
parent 74654c65
;;; loadhist.el --- lisp functions for working with feature groups
;; Copyright (C) 1995, 1998 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1998, 2000 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Version: 1.0
;; Maintainer: FSF
;; Keywords: internal
;; This file is part of GNU Emacs.
......@@ -34,72 +34,65 @@
(defun feature-symbols (feature)
"Return the file and list of symbols associated with a given FEATURE."
(catch 'foundit
(mapcar
(function (lambda (x)
(if (member (cons 'provide feature) (cdr x))
(throw 'foundit x))))
load-history)
(mapc (lambda (x)
(if (member (cons 'provide feature) (cdr x))
(throw 'foundit x)))
load-history)
nil))
(defun feature-file (feature)
"Return the file name from which a given FEATURE was loaded.
Actually, return the load argument, if any; this is sometimes the name of a
Lisp file without an extension. If the feature came from an eval-buffer on
a buffer with no associated file, or an eval-region, return nil."
Lisp file without an extension. If the feature came from an `eval-buffer' on
a buffer with no associated file, or an `eval-region', return nil."
(if (not (featurep feature))
(error "%s is not a currently loaded feature" (symbol-name feature))
(error "%S is not a currently loaded feature" feature)
(car (feature-symbols feature))))
(defun file-provides (file)
"Return the list of features provided by FILE."
(let ((symbols (cdr (assoc file load-history))) (provides nil))
(mapcar
(function (lambda (x)
(if (and (consp x) (eq (car x) 'provide))
(setq provides (cons (cdr x) provides)))))
symbols)
provides
))
(let ((symbols (cdr (assoc file load-history)))
provides)
(mapc (lambda (x)
(if (and (consp x) (eq (car x) 'provide))
(setq provides (cons (cdr x) provides))))
symbols)
provides))
(defun file-requires (file)
"Return the list of features required by FILE."
(let ((symbols (cdr (assoc file load-history))) (requires nil))
(mapcar
(function (lambda (x)
(if (and (consp x) (eq (car x) 'require))
(setq requires (cons (cdr x) requires)))))
symbols)
requires
))
(defun file-set-intersect (p q)
;; Return the set intersection of two lists
(let ((symbols (cdr (assoc file load-history)))
requires)
(mapc (lambda (x)
(if (and (consp x) (eq (car x) 'require))
(setq requires (cons (cdr x) requires))))
symbols)
requires))
(defsubst file-set-intersect (p q)
"Return the set intersection of two lists."
(let ((ret nil))
(mapcar
(function (lambda (x) (if (memq x q) (setq ret (cons x ret)))))
p)
ret
))
(dolist (x p ret)
(if (memq x q) (setq ret (cons x ret))))
ret))
(defun file-dependents (file)
"Return the list of loaded libraries that depend on FILE.
This can include FILE itself."
(let ((provides (file-provides file)) (dependents nil))
(mapcar
(function (lambda (x)
(if (file-set-intersect provides (file-requires (car x)))
(setq dependents (cons (car x) dependents)))))
load-history)
dependents
))
(let ((provides (file-provides file))
(dependents nil))
(dolist (x load-history dependents)
(if (file-set-intersect provides (file-requires (car x)))
(setq dependents (cons (car x) dependents))))
dependents))
(defun read-feature (prompt)
"Read a feature name \(string\) from the minibuffer.
Prompt with PROMPT and completing from `features', and
return the feature \(symbol\)."
(intern (completing-read prompt
(mapcar (function (lambda (feature)
(list (symbol-name feature))))
(mapcar (lambda (feature)
(list (symbol-name feature)))
features)
nil t)))
......@@ -110,6 +103,7 @@ before-change-functions blink-paren-function
buffer-access-fontify-functions command-line-functions
comment-indent-function kill-buffer-query-functions
kill-emacs-query-functions lisp-indent-function
mouse-position-function
redisplay-end-trigger-functions temp-buffer-show-function
window-scroll-functions window-size-change-functions
write-region-annotate-functions)
......@@ -158,10 +152,10 @@ is nil, raise an error."
(string-match "-hooks?\\'" (symbol-name x)))
(and (fboundp x) ; Known abnormal hooks etc.
(memq x loadhist-hook-functions)))
(mapcar (lambda (y) (remove-hook x y))
(cdr flist))))))
(mapcar
(lambda (x)
(dolist (y (cdr flist))
(remove-hook x y))))))
(mapc
(lambda (x)
(cond ((stringp x) nil)
((consp x)
;; Remove any feature names that this file provided.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment