;;; load-fns.el --- Library loading functions ;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000 Noah S. Friedman ;; Author: Noah Friedman ;; Maintainer: friedman@splode.com ;; $Id: load-fns.el,v 1.2 2000/02/18 20:36:58 friedman Exp $ ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, you can either send email to this ;; program's maintainer or write to: The Free Software Foundation, ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; Code: ;;;###autoload (defvar load-offer-compile-dynamic-p nil "*If non-nil, `load-offer-compile' will compile for dynamic loading. This value of this variable is temporarily bound to both `byte-compile-dynamic' and `byte-compile-dynamic-docstrings' while compiling.") ;;;###autoload (defvar load-offer-compile-default-action 'query "*Default action to take for files which need compiling. When the function `load-offer-compile' determines that a bytecode file is missing or out of date with respect to the source file, it will use the value of this variable to determine what to do. If the value is the symbol `query', `ask', or is nil, interactively prompt user with a menu of choices. If the value is `skip', do not load the file at all. If the value is `compile-and-load', compile the source file and then load the compiled program. If the value is `load-and-compile', load the source file, then compile the program. This is rarely useful. If the value is `load-source', just load the source file without compiling anything. If the value is `load-compiled', load the already-compiled file \(which may be out of date\). If the compiled file doesn't exist, the source file will be loaded but no compilation will be done.") ;;;###autoload (defvar load-offer-compile-check-directory-function 'load-offer-compile-check-directory "*Function to run to check for missing bytecode directory. Function takes one argument, a directory name. If function returns nil, no attempt will be made to compile files. This hook exists so that the missing directories can be optionally created.") ;;;###autoload (defvar load-offer-compile-check-directory-mkdir-p 'query "*Action to take if bytecode directory does not exist. If a directory specified to `load-offer-compile-check-directory' does not exist, this variable is consulted to decide what to do. If value is `t', create directory. If value is nil, do not create directory; source files whose bytecode files go into that directory cannot be compiled. For any other value, query user interactively.") ;; This is not a user option. ;; If user is asked to create a bytecode directory and declines, that ;; directory name is added to this list so that they are never asked about ;; it again during this session. (defvar load-offer-compile-check-directory-declined nil) ;;;###autoload (defun load-offer-compile (file &rest load-flags) "Load FILE, offering \(interactively\) to compile if source file is newer. Any additional args to this function are passed to `load'. If called interactively, completion on library names in `load-path' is available." (interactive (list (completing-read-emacs-lisp-library "Load library: "))) (let ((byte-compile-dynamic load-offer-compile-dynamic-p) (byte-compile-dynamic-docstrings load-offer-compile-dynamic-p) (debug-on-error t) (match-data (match-data)) (path load-path) (action load-offer-compile-default-action) (compile-after-load nil) (after-load-forms nil) (load-result nil) (load-file file) (load-filec nil)) ;; Canonicalize file name. (cond ((string-match "/" load-file)) (t (setq load-file (concat load-file ".el")) (while path (if (file-exists-p (concat (car path) "/" load-file)) (setq load-file (concat (car path) "/" load-file) path nil) (setq path (cdr path)))))) (cond ((and (file-exists-p load-file) (progn (setq load-filec (byte-compile-dest-file load-file)) (and (funcall load-offer-compile-check-directory-function (file-name-directory load-filec)) (file-newer-than-file-p load-file load-filec)))) (and (memq action '(query ask nil)) (setq action (load-offer-compile-choice load-file load-filec))) (cond ((eq action 'skip) (setq load-file nil)) ((eq action 'compile-and-load) (byte-compile-file load-file) (setq load-file load-filec)) ((eq action 'load-and-compile) (setq compile-after-load t)) ((eq action 'load-source)) ((and (eq action 'load-compiled) (file-exists-p load-filec)) (setq load-file load-filec)))) (t (setq load-file file))) (cond (load-file (setq load-result (apply 'load load-file load-flags)) ;; We may not have loaded exactly the file name specified to ;; this function, and since the match in after-load-alist must ;; be exact, try matching non-absolute entries if we in fact ;; loaded a file by a different name, then evaluate the forms in ;; after-load-alist manually. (cond ((eq load-file file));; already evaluated ((not (boundp 'after-load-alist)));; nothing to eval ((assoc load-file after-load-alist));; already evaluated ((setq after-load-forms (assoc (file-name-sans-extension (file-name-nondirectory load-file)) after-load-alist)) (eval (cons 'progn (cdr after-load-forms))))))) (and compile-after-load load-file (byte-compile-file load-file)) (store-match-data match-data) load-result)) ;; Check to see if directory exists and if not, query for its creation. ;; Remember which directories the user has declined to create so we do not ;; repeatedly ask the same questions every time this function is invoked. (defun load-offer-compile-check-directory (dir) (cond ((file-exists-p dir)) ((eq load-offer-compile-check-directory-mkdir-p t) (make-directory dir t)) ((eq load-offer-compile-check-directory-mkdir-p nil) nil) ((member dir load-offer-compile-check-directory-declined) nil) ((let ((ans nil) (edir dir)) (while (not (file-exists-p edir)) (setq edir (file-name-directory (directory-file-name edir)))) (load-offer-compile-query "*Bytecode directory missing*" (format "%s:\n\n\t%s\n\n%s:\n\n\t%s\n\n%s, %s." "Missing bytecode directory" (directory-file-name dir) "Deepest existing directory is" (directory-file-name edir) "If bytecode directory is not created" "some files cannot be compiled") "Create missing directories? " (lambda (c) (cond ((char-equal c ?y) (setq ans t) nil) ((char-equal c ?n) (setq ans nil) nil) (t 'retry)))) ans) (make-directory dir t) t) (t ;; User said no. Do not ask about this directory again. (setq load-offer-compile-check-directory-declined (cons dir load-offer-compile-check-directory-declined)) nil))) ;; Ask user what to do about a file which needs compiling. ;; Return value is like that of `load-offer-compile-default-action'. (defun load-offer-compile-choice (load-file load-filec) (let* ((abbrev (if (fboundp 'abbreviate-file-name) 'abbreviate-file-name 'identity)) (init (file-name-nondirectory load-file)) (initc (concat init "c")) (init-dir (funcall abbrev (file-name-directory load-file))) (init-dirc (funcall abbrev (file-name-directory load-filec))) (result nil)) (load-offer-compile-query "*Load Init File*" (format "%s\n\n%s\n%s\n%s\n%s\n%s" (cond ((string= init-dir init-dirc) (format "In directory %s,\n%s." init-dir (if (file-exists-p load-filec) (format "%s is older than %s" initc init) (format "%s is not byte-compiled" init)))) ((file-exists-p load-filec) (format "The file %s%s\nis older than %s%s." init-dirc initc init-dir init)) (t (format "%s is not byte-compiled." init))) (format "0\tSkip %s entirely." file) (format "1\tCompile %s and then load it." initc) (format "2\tLoad %s, then compile %s." init initc) (format "3\tJust load %s." init) (if (file-exists-p load-filec) (format "4\tJust load %s (which is out of date)." initc) "")) (format "What to do about %s? " file) (function (lambda (c) (cond ((char-equal c ?0) (setq result 'skip) nil) ((char-equal c ?1) (setq result 'compile-and-load) nil) ((char-equal c ?2) (setq result 'load-and-compile) nil) ((char-equal c ?3) (setq result 'load-source) nil) ((and (char-equal c ?4) (file-exists-p load-filec)) (setq result 'load-compiled) nil) (t 'retry))))) result)) ;; Display a buffer with a temporary message, display an echo-area prompt, ;; read a character of input. Run action on read character. ;; If function returns t, another character of input is read. ;; inhibit-quit is set so that C-g may be read. (defun load-offer-compile-query (tmpbuf-name tmpbuf-msg prompt action) (let ((winconfig (current-window-configuration)) (buf (with-output-to-temp-buffer tmpbuf-name (princ tmpbuf-msg) standard-output)) (cursor-in-echo-area t) (inhibit-quit t) (loop t) c) (unwind-protect (while loop (message prompt) (setq c (read-char)) (setq quit-flag nil) (setq loop (cond ((char-equal c ?\C-g) (signal 'quit '("Well fuck you then.")) nil) ((funcall action c)))) (cond ((eq loop 'retry) (message "Invalid response.") (sit-for 2)))) (kill-buffer buf) (set-window-configuration winconfig))) (if inhibit-quit (error "inhibit-quit is set!"))) (put 'load-offer-compile-query 'lisp-indent-function 1) ;;;###autoload (defun load-libraries-with-debugging-if-exist (&rest libs) (while libs ;; Make sure debug-on-error is reset for each file, in case one of them ;; resets it. (let ((debug-on-error t)) (load (car libs) t)) (setq libs (cdr libs)))) (put 'load-libraries-with-debugging-if-exist 'lisp-indent-function 0) ;;;###autoload (defun override-autoloads (alist) "Override any previous autoloads and re-autoload. Each argument should be a cons in which the car consists of the function name, and the cdr is the file to load it from. If the function is already defined \(i.e. it is not currently an autoload\), it is not changed." (let (sym file) (while alist (setq sym (car (car alist)) file (cdr (car alist)) alist (cdr alist)) (if (or (not (fboundp sym)) (and (listp (symbol-function sym)) (eq 'autoload (car (symbol-function sym))))) (progn (fmakunbound sym) (autoload sym file nil t)))))) (put 'override-autoloads 'lisp-indent-function 0) ;;;###autoload (defun require-soft (feature &optional file) "Try to require FEATURE, but don't signal an error if require fails." ;; Check that feature isn't already present, because condition-case is ;; too much overhead to bother with unless it's necessary. (or (featurep feature) (condition-case nil (require feature file) (error nil)))) ;; This is also defined in files.el, but the version here offers completion ;; on available library names. ;;;###autoload (defun load-library (library) "Load the library named LIBRARY. This is an interface to the function `load'. Completion on library names in `load-path' is available via the `fff-elisp' package." (interactive (list (funcall (if (require-soft 'fff-elisp) 'fff-completing-read-emacs-lisp-library 'read-string) "Load library: "))) (load library)) (provide 'load-fns) ;;; load-fns.el ends here.