Mercurial > hg > xemacs-beta

comparison lisp/shadow.el @ 373:6240c7796c7a r21-2b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b2
author cvs
date Mon, 13 Aug 2007 11:04:06 +0200
parents 0e522484dd2a
children 8626e4521993
comparison
equal deleted inserted replaced
372:49e1ed2d7ed8 373:6240c7796c7a
4 4
5 ;; Author: Terry Jones <terry@santafe.edu> 5 ;; Author: Terry Jones <terry@santafe.edu>
6 ;; Keywords: lisp 6 ;; Keywords: lisp
7 ;; Created: 15 December 1995 7 ;; Created: 15 December 1995
8 8
9 ;; This file is part of GNU Emacs. 9 ;; This file is part of XEmacs.
10 10
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; XEmacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by 12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option) 13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version. 14 ;; any later version.
15 15
16 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; GNU Emacs is distributed in the hope that it will be useful,
49 ;; emacs -batch -l shadow.el -f list-load-path-shadows 49 ;; emacs -batch -l shadow.el -f list-load-path-shadows
50 ;; 50 ;;
51 ;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions, 51 ;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
52 ;; rewritings & speedups. 52 ;; rewritings & speedups.
53 53
54 ;; 1998-08-15 Martin Buchholz: Speed up using hashtables instead of lists.
55
54 ;;; Code: 56 ;;; Code:
55 57
56 (defun find-emacs-lisp-shadows (&optional path) 58 (defun find-emacs-lisp-shadows (&optional path)
57 "Return a list of Emacs Lisp files that create shadows. 59 "Return a list of Emacs Lisp files that create shadows.
58 This function does the work for `list-load-path-shadows'. 60 This function does the work for `list-load-path-shadows'.
62 the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc\) 64 the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc\)
63 are stripped from the file names in the list. 65 are stripped from the file names in the list.
64 66
65 See the documentation for `list-load-path-shadows' for further information." 67 See the documentation for `list-load-path-shadows' for further information."
66 68
67 (or path (setq path load-path)) 69 (let (shadows ; List of shadowings, to be returned.
68
69 (let (true-names ; List of dirs considered.
70 shadows ; List of shadowings, to be returned.
71 files ; File names ever seen, with dirs.
72 dir ; The dir being currently scanned. 70 dir ; The dir being currently scanned.
73 curr-files ; This dir's Emacs Lisp files. 71 curr-files ; This dir's Emacs Lisp files.
74 orig-dir ; Where the file was first seen. 72 orig-dir ; Where the file was first seen.
75 files-seen-this-dir ; Files seen so far in this dir. 73 (file-dirs
76 file) ; The current file. 74 (make-hashtable 2000 'equal)) ; File names ever seen, with dirs.
77 75 (true-names
76 (make-hashtable 50 'equal)) ; Dirs ever considered.
77 (files-seen-this-dir
78 (make-hashtable 100 'equal)) ; Files seen so far in this dir.
79 )
78 80
79 (while path 81 (dolist (path-elt (or path load-path))
80 82
81 (setq dir (file-truename (or (car path) "."))) 83 (setq dir (file-truename (or path-elt ".")))
82 (if (member dir true-names) 84 (if (gethash dir true-names)
83 ;; We have already considered this PATH redundant directory. 85 ;; We have already considered this PATH redundant directory.
84 ;; Show the redundancy if we are interactiver, unless the PATH 86 ;; Show the redundancy if we are interactive, unless the PATH
85 ;; dir is nil or "." (these redundant directories are just a 87 ;; dir is nil or "." (these redundant directories are just a
86 ;; result of the current working directory, and are therefore 88 ;; result of the current working directory, and are therefore
87 ;; not always redundant). 89 ;; not always redundant).
88 (or noninteractive 90 (or noninteractive
89 (and (car path) 91 (and path-elt
90 (not (string= (car path) ".")) 92 (not (string= path-elt "."))
91 (message "Ignoring redundant directory %s" (car path)))) 93 (message "Ignoring redundant directory %s" path-elt)))
92 94
93 (setq true-names (append true-names (list dir))) 95 (puthash dir t true-names)
94 (setq dir (or (car path) ".")) 96 (setq dir (or path-elt "."))
95 (setq curr-files (if (file-accessible-directory-p dir) 97 (setq curr-files (if (file-accessible-directory-p dir)
96 (directory-files dir nil ".\\.elc?$" t))) 98 (directory-files dir nil ".\\.elc?$" t)))
97 (and curr-files 99 (and curr-files
98 (not noninteractive) 100 (not noninteractive)
99 (message "Checking %d files in %s..." (length curr-files) dir)) 101 (message "Checking %d files in %s..." (length curr-files) dir))
100 102
101 (setq files-seen-this-dir nil) 103 (clrhash files-seen-this-dir)
102 104
103 (while curr-files 105 (dolist (file curr-files)
104 106
105 (setq file (car curr-files))
106 (setq file (substring 107 (setq file (substring
107 file 0 (if (string= (substring file -1) "c") -4 -3))) 108 file 0 (if (string= (substring file -1) "c") -4 -3)))
108 109
109 ;; FILE now contains the current file name, with no suffix. 110 ;; FILE now contains the current file name, with no suffix.
110 (unless (or (member file files-seen-this-dir) 111 (unless (or (gethash file files-seen-this-dir)
111 ;; Ignore these files. 112 ;; Ignore these files.
112 (member file 113 (member file
113 '("subdirs" 114 '("subdirs"
114 "auto-autoloads" 115 "auto-autoloads"
115 "custom-load" 116 "custom-load"
117 "_pkg" 118 "_pkg"
118 "lpath"))) 119 "lpath")))
119 ;; File has not been seen yet in this directory. 120 ;; File has not been seen yet in this directory.
120 ;; This test prevents us declaring that XXX.el shadows 121 ;; This test prevents us declaring that XXX.el shadows
121 ;; XXX.elc (or vice-versa) when they are in the same directory. 122 ;; XXX.elc (or vice-versa) when they are in the same directory.
122 (setq files-seen-this-dir (cons file files-seen-this-dir)) 123 (puthash file t files-seen-this-dir)
123 124
124 (if (setq orig-dir (assoc file files)) 125 (if (setq orig-dir (gethash file file-dirs))
125 ;; This file was seen before, we have a shadowing. 126 ;; This file was seen before, we have a shadowing.
126 (setq shadows 127 (setq shadows
127 (append shadows 128 (nconc shadows
128 (list (concat (file-name-as-directory (cdr orig-dir)) 129 (list (concat (file-name-as-directory orig-dir)
129 file) 130 file)
130 (concat (file-name-as-directory dir) 131 (concat (file-name-as-directory dir)
131 file)))) 132 file))))
132 133
133 ;; Not seen before, add it to the list of seen files. 134 ;; Not seen before, add it to the list of seen files.
134 (setq files (cons (cons file dir) files)))) 135 (puthash file dir file-dirs))))))
135
136 (setq curr-files (cdr curr-files))))
137 (setq path (cdr path)))
138 136
139 ;; Return the list of shadowings. 137 ;; Return the list of shadowings.
140 shadows)) 138 shadows))
141 139
142 140