annotate lisp/find-paths.el @ 1292:f3437b56874d

[xemacs-hg @ 2003-02-13 09:57:04 by ben] profile updates profile.c: Major reworking. Keep track of new information -- total function timing (includes descendants), GC usage, total GC usage (includes descendants). New functions to be called appropriately from eval.c, alloc.c to keep track of this information. Keep track of when we're actually in a function vs. in its profile, for more accurate timing counts. Track profile overhead separately. Create new mechanism for specifying "internal sections" that are tracked just like regular Lisp functions and even appear in the backtrace if `backtrace-with-internal-sections' is non-nil (t by default for error-checking builds). Add some KKCC information for the straight (non-Elisp) hash table used by profile, which contains Lisp objects in its keys -- but not used yet. Remove old ad-hoc methods for tracking garbage collection, redisplay (which was incorrect anyway when Lisp was called within these sections). Don't record any tick info when blocking under MS Windows, since the timer there is in real time rather than in process time. Make `start-profiling', `stop-profiling' interactive. Be consistent wrt. recursive functions and functions currently on the stack when starting or stopping -- together these make implementing the `total' values extremely difficult. When we start profiling, we act as if we just entered all the functions currently on the stack. Likewise when exiting. Create vars in_profile for tracking time spent inside of profiling, and profiling_lock for setting exclusive access to the main hash table when reading from it or modifying it. (protects against getting screwed up by the signal handle going off at the same time. profile.h: New file. Create macros for declaring internal profiling sections. lisp.h: Move profile-related stuff to profile.h. alloc.c: Keep track of total consing, for profile. Tell profile when we are consing. Use new profile-section method for noting garbage-collection. alloc.c: Abort if we attempt to call the allocator reentrantly. backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile. elhash.c: Author comment. eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when error-checking is on. eval.c: When unwinding, eval.c: Report to profile when we are about-to-call and just-called wrt. a function. alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by profile and `backtrace-with-internal-sections'. event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake. event-stream.c: Record internal profiling sections for getting, dispatching events. extents.c: Record internal profiling sections for map_extents. hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code since the signal handler is the main grower but can't allow a realloc(). We make sure, at critical points, that the table is large enough.) lread.c: Create internal profiling sections for `load' (which may be triggered internally by autoload, etc.). redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare internal profiling section for redisplay. text.c: Use new macros to declare internal profiling sections for char-byte conversion and internal-external conversion. SEMI-UNRELATED CHANGES: ----------------------- text.c: Update the long comments.
author ben
date Thu, 13 Feb 2003 09:57:08 +0000
parents 5636ae1c0234
children 4542b72c005e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; find-paths.el --- setup various XEmacs paths
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (c) 1993, 1994 Sun Microsystems, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Board of Trustees, University of Illinois
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Author: Mike Sperber <sperber@informatik.uni-tuebingen.de>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Keywords: internal, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
776
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
34 ;; This file contains basic library functionality for manipulating paths
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
35 ;; and path lists and finding paths in the XEmacs hierarchy.
79940b592197 [xemacs-hg @ 2002-03-15 07:43:14 by ben]
ben
parents: 689
diff changeset
36
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (defvar paths-version-control-filename-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 "^\\(RCS\\|CVS\\|SCCS\\)$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 "File bases associated with version control.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (defvar paths-lisp-filename-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 "^\\(.*\\.elc?\\)$"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 "File bases that contain Lisp file.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (defvar paths-no-lisp-directory-regexp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (concat "\\(" paths-version-control-filename-regexp "\\)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 "\\|"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 "\\(" paths-lisp-filename-regexp "\\)")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 "File bases that may not be directories containing Lisp code.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (defun paths-find-recursive-path (directories &optional max-depth exclude-regexp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 "Return a list of the directory hierarchy underneath DIRECTORIES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 The returned list is sorted by pre-order and lexicographically.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 MAX-DEPTH limits the depth of the search to MAX-DEPTH level,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 EXCLUDE-REGEXP is a regexp that matches directory names to exclude
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 from the search."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (let ((path '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (while directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (let ((directory (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (car directories)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (if (paths-file-readable-directory-p directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (let ((raw-entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (if (equal 0 max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 '()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 (directory-files directory nil "^[^.-]")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (reverse-dirs '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 (while raw-entries
531
0493e9f3c27f [xemacs-hg @ 2001-05-12 11:16:12 by ben]
ben
parents: 442
diff changeset
73 (if (not (and exclude-regexp
0493e9f3c27f [xemacs-hg @ 2001-05-12 11:16:12 by ben]
ben
parents: 442
diff changeset
74 (string-match exclude-regexp (car raw-entries))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (setq reverse-dirs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (cons (expand-file-name (car raw-entries) directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 reverse-dirs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (setq raw-entries (cdr raw-entries)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (let ((sub-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (paths-find-recursive-path (reverse reverse-dirs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (if (numberp max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (- max-depth 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 exclude-regexp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (setq path (nconc path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (list directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 sub-path))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (setq directories (cdr directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (defun paths-file-readable-directory-p (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 "Check if filename is a readable directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (and (file-directory-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (file-readable-p filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (defun paths-find-recursive-load-path (directories &optional max-depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 "Construct a recursive load path underneath DIRECTORIES."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (paths-find-recursive-path directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 max-depth paths-no-lisp-directory-regexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (defun paths-emacs-root-p (directory)
1227
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
103 "Check if DIRECTORY is a plausible installation root."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; installed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (paths-file-readable-directory-p (paths-construct-path (list directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "lib"
689
6a0eecc6df0e [xemacs-hg @ 2001-12-06 09:35:50 by michaels]
michaels
parents: 531
diff changeset
108 (construct-emacs-version-name))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 ;; in-place or windows-nt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
1227
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
114 (defun paths-emacs-data-root-p (directory)
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
115 "Check if DIRECTORY is a plausible data installation root.
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
116 A data installation root is one containing data files that may be shared
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
117 among multiple different versions of XEmacs, the packages in particular."
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
118 (or
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
119 ;; installed
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
120 (paths-file-readable-directory-p (paths-construct-path (list directory
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
121 "lib"
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
122 emacs-program-name)))
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
123 (paths-file-readable-directory-p (paths-construct-path (list directory
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
124 "lib"
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
125 (construct-emacs-version-name))))
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
126 ;; in-place or windows-nt
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
127 (and
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
128 (paths-file-readable-directory-p (paths-construct-path (list directory "lisp")))
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
129 (paths-file-readable-directory-p (paths-construct-path (list directory "etc"))))))
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
130
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (defun paths-chase-symlink (file-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 "Chase a symlink until the bitter end."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (let ((maybe-symlink (file-symlink-p file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (if maybe-symlink
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (let* ((directory (file-name-directory file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (destination (expand-file-name maybe-symlink directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (paths-chase-symlink destination))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 file-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (defun paths-find-emacs-root
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (invocation-directory invocation-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 "Find the run-time root of XEmacs."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (let* ((executable-file-name (paths-chase-symlink
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (concat invocation-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 invocation-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (executable-directory (file-name-directory executable-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (maybe-root-1 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (paths-construct-path '("..") executable-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (maybe-root-2 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (paths-construct-path '(".." "..") executable-directory))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (or (and (paths-emacs-root-p maybe-root-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 maybe-root-1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (and (paths-emacs-root-p maybe-root-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 maybe-root-2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (defun paths-construct-path (components &optional expand-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 "Convert list of path components COMPONENTS into a path.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 to EXPAND-FILE-NAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (let* ((reverse-components (reverse components))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (last-component (car reverse-components))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (first-components (reverse (cdr reverse-components)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (apply #'concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (append (mapcar #'file-name-as-directory first-components)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (list last-component)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (if expand-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (expand-file-name path expand-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 path)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (defun paths-construct-emacs-directory (root suffix base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 "Construct a directory name within the XEmacs hierarchy."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (file-name-as-directory root)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 suffix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 base))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (defun paths-find-emacs-directory (roots suffix base
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
181 &optional envvar default keep-suffix)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 "Find a directory in the XEmacs hierarchy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ROOTS must be a list of installation roots.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 SUFFIX is the subdirectory from there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 BASE is the base to look for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ENVVAR is the name of the environment variable that might also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 specify the directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 DEFAULT is the preferred value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 If KEEP-SUFFIX is non-nil, the suffix must be respected in searching
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
190 the directory."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (let ((preferred-value (or (and envvar (getenv envvar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 default)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (if (and preferred-value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (paths-file-readable-directory-p preferred-value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (file-name-as-directory preferred-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (catch 'gotcha
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (while roots
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
198 (let* ((root (car roots))
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
199 ;; installed
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
200 (path (paths-construct-emacs-directory root suffix base)))
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
201 (if (paths-file-readable-directory-p path)
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
202 (throw 'gotcha path)
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
203 ;; in-place
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
204 (if (null keep-suffix)
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
205 (let ((path (paths-construct-emacs-directory root "" base)))
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
206 (if (paths-file-readable-directory-p path)
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
207 (throw 'gotcha path))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (setq roots (cdr roots)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
211 (defun paths-find-site-directory (roots base &optional envvar default)
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
212 "Find a site-specific directory in the XEmacs hierarchy."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (paths-find-emacs-directory roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (paths-construct-path (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 "lib"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 emacs-program-name)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 base
1218
ceedb6eeaba8 [xemacs-hg @ 2003-01-16 08:59:47 by michaels]
michaels
parents: 865
diff changeset
219 envvar default))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (defun paths-find-version-directory (roots base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 &optional envvar default enforce-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 "Find a version-specific directory in the XEmacs hierarchy.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (paths-find-emacs-directory roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (paths-construct-path
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (list "lib"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (construct-emacs-version-name))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 envvar default
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 enforce-version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (defun paths-find-architecture-directory (roots base &optional envvar default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 "Find an architecture-specific directory in the XEmacs hierarchy."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 ;; from more to less specific
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (paths-find-version-directory roots
865
987c2a685f39 [xemacs-hg @ 2002-06-04 16:45:42 by michaels]
michaels
parents: 776
diff changeset
239 (paths-construct-path
987c2a685f39 [xemacs-hg @ 2002-06-04 16:45:42 by michaels]
michaels
parents: 776
diff changeset
240 (list system-configuration base))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 envvar default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (paths-find-version-directory roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 envvar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (paths-find-version-directory roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 system-configuration
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 envvar)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (defun construct-emacs-version-name ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 "Construct the raw XEmacs version number."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (concat emacs-program-name "-" emacs-program-version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defun paths-directories-which-exist (directories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 "Return the directories among DIRECTORIES."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (let ((reverse-directories '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (while directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (if (paths-file-readable-directory-p (car directories))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (setq reverse-directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (cons (car directories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 reverse-directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (setq directories (cdr directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (reverse reverse-directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (defun paths-uniq-append (list-1 list-2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 "Append LIST-1 and LIST-2, omitting duplicates."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (let ((reverse-survivors '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (while list-2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (if (null (member (car list-2) list-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (setq reverse-survivors (cons (car list-2) reverse-survivors)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (setq list-2 (cdr list-2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (append list-1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (reverse reverse-survivors))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (defun paths-filter (predicate list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 "Delete all matches of PREDICATE from LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (let ((reverse-result '()))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (while list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (if (funcall predicate (car list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (setq reverse-result (cons (car list) reverse-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (nreverse reverse-result)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (defun paths-decode-directory-path (string &optional drop-empties)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 "Split STRING at path separators into a directory list.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
285 Non-\"\" components are converted into directory form.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 Otherwise, they are left alone."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (let* ((components (split-path string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (directories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (mapcar #'(lambda (component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (if (string-equal "" component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 component
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (file-name-as-directory component)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 components)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (if drop-empties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (paths-filter #'(lambda (component)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (null (string-equal "" component)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 directories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 directories)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (defun paths-find-emacs-roots (invocation-directory
1227
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
302 invocation-name
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
303 root-p)
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
304 "Find all plausible installation roots for XEmacs.
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
305 INVOCATION-DIRECTORY is the directory from which XEmacs was started.
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
306 INVOCATION-NAME is the name of the XEmacs executable that was originally
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
307 started.
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
308 ROOT-P is a function that tests whether a root is plausible."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (let* ((potential-invocation-root
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (paths-find-emacs-root invocation-directory invocation-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (invocation-roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (and potential-invocation-root
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (list potential-invocation-root)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (potential-installation-roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (paths-uniq-append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (and configure-exec-prefix-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (list (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 configure-exec-prefix-directory)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (and configure-prefix-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (list (file-name-as-directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 configure-prefix-directory)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (installation-roots
1227
5636ae1c0234 [xemacs-hg @ 2003-01-22 20:31:52 by michaels]
michaels
parents: 1218
diff changeset
323 (paths-filter root-p potential-installation-roots)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (paths-uniq-append invocation-roots
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 installation-roots)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 ;;; find-paths.el ends here