Mercurial > hg > xemacs-beta

comparison lisp/packages.el @ 274:ca9a9ec9c1c1 r21-0b35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 6330739388db
comparison
equal deleted inserted replaced
273:411aac7253ef 274:ca9a9ec9c1c1
72 (defvar last-packages nil 72 (defvar last-packages nil
73 "Packages last in the load path.") 73 "Packages last in the load path.")
74 74
75 (defvar last-package-load-path nil 75 (defvar last-package-load-path nil
76 "Load path for packages last in the load path.") 76 "Load path for packages last in the load path.")
77
78 (defvar package-locations
79 (list
80 (list "~/.xemacs" 'early #'(lambda () t))
81 (list "mule-packages" 'late #'(lambda () (featurep 'mule)))
82 (list "packages" 'late #'(lambda () t))
83 (list "infodock-packages" 'late #'(lambda () (featurep 'infodock))))
84 "Locations of the various package directories.
85 This is a list each of whose elements describes one directory.
86 A directory description is a three-element list.
87 The first element is either an absolute path or a subdirectory
88 in the XEmacs hierarchy.
89 The second component is one of the symbols EARLY, LATE, LAST,
90 depending on the load-path segment the hierarchy is supposed to
91 show up in.
92 The third component is a thunk which, if it returns NIL, causes
93 the directory to be ignored.")
77 94
78 (defun package-get-key-1 (info key) 95 (defun package-get-key-1 (info key)
79 "Locate keyword `key' in list." 96 "Locate keyword `key' in list."
80 (cond ((null info) 97 (cond ((null info)
81 nil) 98 nil)
296 (setq dir-list data-directory-list)) 313 (setq dir-list data-directory-list))
297 (locate-file name dir-list)) 314 (locate-file name dir-list))
298 315
299 ;; Path setup 316 ;; Path setup
300 317
301 (defun packages-find-package-path (roots) 318 (defun packages-find-package-directories (roots base)
302 "Construct the package path underneath installation roots ROOTS." 319 "Find a set of package directories."
303 (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) 320 (let ((version-directory (paths-find-version-directory roots base))
304 (if envvar-value 321 (site-directory (paths-find-site-directory roots base)))
305 (decode-path-internal envvar-value) 322 (paths-uniq-append
306 (let ((site-base-directory (paths-find-site-directory roots "packages")) 323 (and version-directory (list version-directory))
307 (version-base-directory (paths-find-version-directory roots "packages"))) 324 (and site-directory (list site-directory)))))
308 (if (or site-base-directory version-base-directory)
309 (let ((site-mule-directory
310 (and (featurep 'mule)
311 (paths-find-site-directory roots
312 "mule-packages")))
313 (version-mule-directory
314 (and (featurep 'mule)
315 (paths-find-version-directory roots
316 "mule-packages")))
317 ;; There needs to be a cleverer way of doing this
318 (site-infodock-directory
319 (and (featurep 'infodock)
320 (paths-find-site-directory roots
321 "infodock-packages")))
322 (version-infodock-directory
323 (and (featurep 'infodock)
324 (paths-find-version-directory roots
325 "infodock-packages"))))
326 (append '("~/.xemacs/")
327 '(nil)
328 (and version-infodock-directory
329 (null (string-equal version-infodock-directory
330 site-infodock-directory))
331 (list version-infodock-directory))
332 (and site-infodock-directory
333 (list site-infodock-directory))
334 (and version-mule-directory
335 (null (string-equal version-mule-directory
336 site-mule-directory))
337 (list version-mule-directory))
338 (and site-mule-directory
339 (list site-mule-directory))
340 (and version-base-directory
341 (null (string-equal version-base-directory
342 site-base-directory))
343 (list version-base-directory))
344 (and site-base-directory
345 (list site-base-directory))))
346 configure-package-path)))))
347 325
348 (defvar packages-special-bases '("etc" "info" "lisp" "lib-src" "bin") 326 (defvar packages-special-bases '("etc" "info" "lisp" "lib-src" "bin")
349 "Special subdirectories of packages.") 327 "Special subdirectories of packages.")
350 328
351 (defun packages-find-packages-in-directories (directories) 329 (defun packages-find-packages-in-directories (directories)
353 (paths-find-recursive-path directories 331 (paths-find-recursive-path directories
354 (append paths-version-control-bases 332 (append paths-version-control-bases
355 packages-special-bases))) 333 packages-special-bases)))
356 334
357 (defun packages-split-path (path) 335 (defun packages-split-path (path)
358 "Split PATH at NIL, return pair with two components. 336 "Split PATH at \"/\", return pair with two components.
359 The second component is shared with PATH." 337 The second component is shared with PATH."
360 (let ((reverse-tail '()) 338 (let ((reverse-tail '())
361 (rest path)) 339 (rest path))
362 (while (and rest (null (null (car rest)))) 340 (while (and rest (null (string-equal "/" (car rest))))
363 (setq reverse-tail (cons (car rest) reverse-tail)) 341 (setq reverse-tail (cons (car rest) reverse-tail))
364 (setq rest (cdr rest))) 342 (setq rest (cdr rest)))
365 (if (null rest) 343 (if (null rest)
366 (cons path nil) 344 (cons path nil)
367 (cons (nreverse reverse-tail) (cdr rest))))) 345 (cons (nreverse reverse-tail) (cdr rest)))))
368 346
369 (defun packages-find-packages (package-path &optional inhibit) 347 (defun packages-split-package-path (package-path)
370 "Search for all packages in PACKAGE-PATH. 348 "Split up PACKAGE-PATH into early, late and last components.
371 PACKAGE-PATH may distinguish (by NIL-separation) between early, 349 The separation is by \"/\" components.
372 late and last packages.
373 If INHIBIT is non-NIL, return empty paths.
374 This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)." 350 This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)."
351 ;; When in doubt, it's late
352 (let* ((stuff (packages-split-path package-path))
353 (early (and (cdr stuff) (car stuff)))
354 (late+last (or (cdr stuff) (car stuff)))
355 (stuff (packages-split-path late+last))
356 (late (car stuff))
357 (last (cdr stuff)))
358 (list (packages-find-packages-in-directories early)
359 (packages-find-packages-in-directories late)
360 (packages-find-packages-in-directories last))))
361
362 (defun packages-deconstruct (list consumer)
363 "Deconstruct LIST and feed it to CONSUMER."
364 (apply consumer list))
365
366 (defun packages-find-packages-by-name (roots name)
367 "Find a package hierarchy by its name."
368 (packages-find-packages-in-directories
369 (if (and (file-name-absolute-p name)
370 (file-name-directory (expand-file-name name)))
371 (list (file-name-as-directory (expand-file-name name)))
372 (packages-find-package-directories roots name))))
373
374 (defun packages-find-packages-at-time
375 (roots package-locations time &optional default)
376 "Find packages at given time.
377 For the format of PACKAGE-LOCATIONS, see the global variable of the same name.
378 TIME is either 'EARLY, 'LATE, or 'LAST.
379 DEFAULT is a default list of packages."
380 (let ((packages '()))
381 (while package-locations
382 (packages-deconstruct
383 (car package-locations)
384 #'(lambda (name a-time thunk)
385 (if (and (eq time a-time)
386 (funcall thunk))
387 (setq packages
388 (nconc packages
389 (packages-find-packages-by-name roots name))))))
390 (setq package-locations (cdr package-locations)))
391 (paths-uniq-append packages
392 default)))
393
394 (defun packages-find-packages (roots &optional inhibit)
395 "Find the packages."
375 (if inhibit 396 (if inhibit
376 (list '() '() '()) 397 (list '() '() '())
377 ;; When in doubt, it's late 398 (let ((envvar-value (getenv "EMACSPACKAGEPATH")))
378 (let* ((stuff (packages-split-path package-path)) 399 (if envvar-value
379 (early (and (cdr stuff) (car stuff))) 400 (packages-split-package-path envvar-value)
380 (late+last (or (cdr stuff) (car stuff))) 401 (packages-deconstruct
381 (stuff (packages-split-path late+last)) 402 (packages-split-package-path configure-package-path)
382 (late (car stuff)) 403 #'(lambda (configure-early-packages
383 (last (cdr stuff))) 404 configure-late-packages
384 (list (packages-find-packages-in-directories early) 405 configure-last-packages)
385 (packages-find-packages-in-directories late) 406 (list (packages-find-packages-at-time roots package-locations 'early
386 (packages-find-packages-in-directories last))))) 407 configure-early-packages)
408 (packages-find-packages-at-time roots package-locations 'late
409 configure-late-packages)
410 (packages-find-packages-at-time roots package-locations 'last
411 configure-last-packages))))))))
387 412
388 (defun packages-find-package-library-path (packages suffixes) 413 (defun packages-find-package-library-path (packages suffixes)
389 "Construct a path into a component of the packages hierarchy. 414 "Construct a path into a component of the packages hierarchy.
390 PACKAGES is a list of package directories. 415 PACKAGES is a list of package directories.
391 SUFFIXES is a list of names of package subdirectories to look for." 416 SUFFIXES is a list of names of package subdirectories to look for."