7:11 a.m.
User: ben
Date: 05/02/03 08:11:30
Modified: xemacs/src ChangeLog lread.c lisp.h
Added: xemacs/lisp easy-mmode.el regexp-opt.el
Log:
behavior ws #4: package-suppress, autoload update/sync, add easy-mmode/regexp-opt to
core
lread.c, lisp.h: Remove undeeded Vload_file_name_internal_the_purecopy,
Qload_file_name -- use internal_bind_lisp_object instead of
specbind.
Add load-suppress-alist.
* easy-mmode.el, regexp-opt.el:
Move these files into core.
Uncomment stuff depending on new custom.el.
autoload.el: Removed.
Major update. Sync with FSF 21.2.
Create the ability to make custom-defines files.
update-elc-2.el, update-elc.el: Rewrite to use new autoload API.
update-elc.el: Add easy-mmode.
Revision Changes Path
1.624 +45 -42 XEmacs/xemacs/lisp/ChangeLog
(In the diff below, changes in quantity of whitespace are not shown.)
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v
retrieving revision 1.623
retrieving revision 1.624
diff -u -b -r1.623 -r1.624
--- ChangeLog 2005/02/03 05:26:39 1.623
+++ ChangeLog 2005/02/03 07:11:19 1.624
＠＠ -1,5 +1,50 ＠＠
2005-02-02 Ben Wing <ben(a)xemacs.org>
+ * easy-mmode.el, regexp-opt.el:
+ Move these files into core.
+ Uncomment stuff depending on new custom.el.
+
+ * autoload.el:
+ * autoload.el (generate-autoload-function): New.
+ * autoload.el (autoload-feature-suffix): New.
+ * autoload.el (generate-autoload-section-continuation): New.
+ * autoload.el (make-autoload):
+ * autoload.el (generate-file-autoloads):
+ * autoload.el (generate-autoload-type-section):
+ * autoload.el (process-one-lisp-autoload): New.
+ * autoload.el (generate-lisp-file-autoloads-1):
+ * autoload.el (generate-c-file-autoloads-1):
+ * autoload.el (generate-custom-defines): New.
+ * autoload.el (print-autoload): Removed.
+ * autoload.el (autoload-print-form): New.
+ * autoload.el (defcustom):
+ * autoload.el (autoload-read-section-header): New.
+ * autoload.el (update-file-autoloads):
+ * autoload.el (update-autoloads-here): Removed.
+ * autoload.el (batch-update-directory-custom-defines): New.
+ * autoload.el (update-autoload-files):
+ * autoload.el (autoload-update-directory-autoloads): Removed.
+ * autoload.el (batch-update-directory-autoloads): New.
+ * autoload.el (autoload-featurep-protect-autoloads):
+ * autoload.el (update-autoloads-from-directory): Removed.
+ * autoload.el (update-custom-define-files): New.
+ * autoload.el (autoload-make-feature-name):
+ * autoload.el (batch-update-autoloads):
+ * autoload.el (batch-update-directory): Removed.
+ * autoload.el (batch-update-one-directory): Removed.
+ * autoload.el (batch-force-update-one-directory): Removed.
+ Major update. Sync with FSF 21.2.
+ Create the ability to make custom-defines files.
+
+ * update-elc-2.el (batch-update-elc-2):
+ * update-elc.el (do-autoload-commands):
+ Rewrite to use new autoload API.
+
+ * update-elc.el (lisp-files-needing-early-byte-compilation):
+ Add easy-mmode.
+
+2005-02-02 Ben Wing <ben(a)xemacs.org>
+
* behavior.el:
* behavior.el (behavior-group-hash-table): New.
* behavior.el (behavior-override-hash-table): New.
＠＠ -207,42 +252,6 ＠＠
2004-11-09 Ben Wing <ben(a)xemacs.org>
- * easy-mmode.el, regexp-opt.el:
- Move these files into core.
- Uncomment stuff depending on new custom.el.
-
- * autoload.el:
- * autoload.el (generate-autoload-function): New.
- * autoload.el (autoload-feature-suffix): New.
- * autoload.el (generate-autoload-section-continuation): New.
- * autoload.el (make-autoload):
- * autoload.el (generate-file-autoloads):
- * autoload.el (generate-autoload-type-section):
- * autoload.el (process-one-lisp-autoload): New.
- * autoload.el (generate-lisp-file-autoloads-1):
- * autoload.el (generate-c-file-autoloads-1):
- * autoload.el (generate-custom-defines): New.
- * autoload.el (print-autoload): Removed.
- * autoload.el (autoload-print-form): New.
- * autoload.el (defcustom):
- * autoload.el (autoload-read-section-header): New.
- * autoload.el (update-file-autoloads):
- * autoload.el (update-autoloads-here): Removed.
- * autoload.el (batch-update-directory-custom-defines): New.
- * autoload.el (update-autoload-files):
- * autoload.el (autoload-update-directory-autoloads): Removed.
- * autoload.el (batch-update-directory-autoloads): New.
- * autoload.el (autoload-featurep-protect-autoloads):
- * autoload.el (update-autoloads-from-directory): Removed.
- * autoload.el (update-custom-define-files): New.
- * autoload.el (autoload-make-feature-name):
- * autoload.el (batch-update-autoloads):
- * autoload.el (batch-update-directory): Removed.
- * autoload.el (batch-update-one-directory): Removed.
- * autoload.el (batch-force-update-one-directory): Removed.
- Major update. Sync with FSF 21.2.
- Create the ability to make custom-defines files.
-
* paragraphs.el:
* paragraphs.el (paragraphs): New.
* paragraphs.el (use-hard-newlines): Removed.
＠＠ -259,12 +268,6 ＠＠
* paragraphs.el (transpose-sentences):
Sync to 21.3. Depends on easy-mmode in core.
- * update-elc-2.el (batch-update-elc-2):
- * update-elc.el (do-autoload-commands):
- Rewrite to use new autoload API.
-
- * update-elc.el (lisp-files-needing-early-byte-compilation):
- Add easy-mmode.
2005-01-31 Ben Wing <ben(a)xemacs.org>
1.21 +597 -378 XEmacs/xemacs/lisp/autoload.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: autoload.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/autoload.el,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- autoload.el 2003/10/15 09:19:10 1.20
+++ autoload.el 2005/02/03 07:11:20 1.21
＠＠ -2,9 +2,10 ＠＠
;; Copyright (C) 1991-1994, 1997, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1996, 2000, 2002, 2003 Ben Wing.
+;; Copyright (C) 1996, 2000, 2002, 2003, 2004 Ben Wing.
-;; Author: Roland McGrath <roland(a)gnu.ai.mit.edu>
+;; Original Author: Roland McGrath <roland(a)gnu.ai.mit.edu>
+;; Heavily Modified: XEmacs Maintainers
;; Keywords: maint
;; This file is part of XEmacs.
＠＠ -24,13 +25,17 ＠＠
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
-;;; Synched up with: Not synched with FSF.
+;;; Synched up with: FSF 21.2 by Ben Wing.
+;;; Note that update-file-autoloads is seriously modified and not really
+;;; syncable.
;;; Commentary:
;; This code keeps auto-autoloads.el files up to date. It interprets
;; magic cookies (of the form ";;;###autoload" in Lisp source files
;; and "/* ###autoload */" in C source files) in various useful ways.
+;; It is also used to maintain custom-defines.el files, since most of
+;; the logic for computing them is the same as for auto-autoloads.el.
;; Usage
;; =====
＠＠ -39,8 +44,7 ＠＠
;; build process, is
;; xemacs -no-packages -batch \
-;; -eval "(setq generated-autoload-file \"PATH\")" \
-;; -l autoload -f autoload-update-directory-autoloads PREFIX DIRECTORY
+;; -l autoload -f batch-update-directory-autoloads PREFIX DIRECTORY
;; which causes XEmacs to update the file named by PATH from the .el
;; files in DIRECTORY (but not recursing into subdirectories) and (if
＠＠ -61,24 +65,13 ＠＠
;; of XEmacs).
;; The probable next step is to fix up the packages to use the
-;; `autoload-update-directory-autoloads' API. However, for backward
+;; `batch-update-directory-autoloads' API. However, for backward
;; compatibility with XEmacs 21.4 and 21.1, this can't be done quickly.
-;; For now the API used in update-elc-2.el:
-
-;; (let* ((dir "DIRECTORY")
-;; (generated-autoload-file (expand-file-name "auto-autoloads.el"
dir))
-;; (autoload-package-name "PREFIX"))
-;; (update-autoload-files (list muledir))
-;; (byte-recompile-file generated-autoload-file 0))
-
-;; is available, but this ugly kludge is deprecated. It will be removed
-;; in favor of using proper arguments instead of special variables.
-
;; For backward compatibility the API used in the packages/XEmacs.rules:
;; xemacs -vanilla -batch -eval "$(AUTOLOAD_PACKAGE_NAME)" \
-;; -l autoload -f batch-update-directory $(AUTOLOAD_PATH)
+;; -l autoload -f batch-update-autoloads $(AUTOLOAD_PATH)
;; is supported, and the implementation is unchanged. However,
;; revision of the API (in a backward compatible way) and the
＠＠ -130,6 +123,10 ＠＠
;;; Code:
+;; Need to load easy-mmode because we expand macro calls to easy-mmode
+;; macros in make-autoloads below.
+(require 'easy-mmode)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Standard file and directory names
＠＠ -144,6 +141,10 ＠＠
;; Dynamic variables for communication among functions
+;; FSF 21.2:
+;; The autoload file is assumed to contain a trailer starting with a FormFeed
+;; character.
+
(defvar generated-autoload-file
(expand-file-name autoload-file-name lisp-directory)
"*File `update-file-autoloads' puts autoloads into.
＠＠ -154,6 +155,11 ＠＠
generally the file named by `autoload-file-name' in the directory being
updated. XEmacs.rules setq's this variable for package autoloads.")
+(defvar generate-autoload-function
+ #'generate-file-autoloads
+ "Function to generate the autoloads for a file and insert at point.
+Called with one argument, the file.")
+
(define-obsolete-variable-alias 'autoload-package-name
'autoload-feature-prefix)
(defvar autoload-feature-prefix nil
＠＠ -164,6 +170,9 ＠＠
auto-autoloads file). Highest priority candidate except for an explicit
argument to `autoload-make-feature-name' (q.v.).")
+(defvar autoload-feature-suffix "-autoloads"
+ "String added to `autoload-feature-prefix' to create the autoload feature
name.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Magic strings in source files
＠＠ -210,40 +219,69 ＠＠
(defconst generate-autoload-section-trailer "\n;;;***\n"
"String which indicates the end of the section of autoloads for a file.")
+(defconst generate-autoload-section-continuation ";;;;;; "
+ "String to add on each continuation of the section header form.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parsing the source file text.
-;; Autoloads in C source differ from those in Lisp source. For historical
-;; reasons, functions handling only Lisp don't have "lisp" in their
names;
-;; maybe this should be changed.
+;; Autoloads in C source differ from those in Lisp source.
(defun make-autoload (form file)
- "Turn a definition generator FORM into an autoload for source file FILE.
-Returns nil if FORM is not a defun, defun*, defmacro, defmacro*,
-define-skeleton, or define-derived-mode."
- (let ((car (car-safe form)))
- (if (memq car '(defun defun* define-skeleton defmacro defmacro*
- define-derived-mode))
- (let ((macrop (memq car '(defmacro defmacro*)))
- name doc)
- (setq form (cdr form)
- name (car form)
- ;; Ignore the arguments.
- form (cdr (cond ((eq car 'define-skeleton)
- form)
- ((eq car 'define-derived-mode)
- (cddr form))
- (t
- (cdr form))))
- doc (car form))
- (if (stringp doc)
- (setq form (cdr form))
- (setq doc nil))
- (list 'autoload (list 'quote name) file doc
- (or (eq car 'define-skeleton)
- (eq car 'define-derived-mode)
- (eq (car-safe (car form)) 'interactive))
- (if macrop (list 'quote 'macro) nil)))
- nil)))
+ "Turn FORM into an autoload or defvar for source file FILE.
+Returns nil if FORM is not a special autoload form (i.e. a function definition
+or macro definition or a defcustom)."
+ (let ((car (car-safe form)) expand)
+ (cond
+ ;; For complex cases, try again on the macro-expansion.
+ ((and (memq car '(easy-mmode-define-global-mode
+ easy-mmode-define-minor-mode define-minor-mode))
+ (setq expand (let ((load-file-name file)) (macroexpand form)))
+ (eq (car expand) 'progn)
+ (memq :autoload-end expand))
+ (let ((end (memq :autoload-end expand)))
+ ;; Cut-off anything after the :autoload-end marker.
+ (setcdr end nil)
+ (cons 'progn
+ (mapcar (lambda (form) (make-autoload form file))
+ (cdr expand)))))
+
+ ;; For special function-like operators, use the `autoload' function.
+ ((memq car '(defun define-skeleton defmacro define-derived-mode
+ define-generic-mode easy-mmode-define-minor-mode
+ easy-mmode-define-global-mode
+ define-minor-mode defun* defmacro*))
+ (let* ((macrop (memq car '(defmacro defmacro*)))
+ (name (nth 1 form))
+ (body (nthcdr (get car 'doc-string-elt) form))
+ (doc (if (stringp (car body)) (pop body))))
+ ;; `define-generic-mode' quotes the name, so take care of that
+ (list 'autoload (if (listp name) name (list 'quote name)) file doc
+ (or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode)) t)
+ (eq (car-safe (car body)) 'interactive))
+ (if macrop (list 'quote 'macro) nil))))
+
+ ;; Convert defcustom to a simpler (and less space-consuming) defvar,
+ ;; but add some extra stuff if it uses :require.
+ ((eq car 'defcustom)
+ (let ((varname (car-safe (cdr-safe form)))
+ (init (car-safe (cdr-safe (cdr-safe form))))
+ (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
+ (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))))
+ (if (not (plist-get rest :require))
+ `(defvar ,varname ,init ,doc)
+ `(progn
+ (defvar ,varname ,init ,doc)
+ (custom-add-to-group ,(plist-get rest :group)
+ ',varname 'custom-variable)
+ (custom-add-load ',varname
+ ,(plist-get rest :require))))))
+
+ ;; nil here indicates that this is not a special autoload form.
+ (t nil))))
(defun make-c-autoload (module)
"Make an autoload list for the DEFUN at point in MODULE.
＠＠ -283,7 +321,7 ＠＠
;; Generating autoloads for a single file
;;;###autoload
-(defun generate-file-autoloads (file &optional funlist)
+(defun generate-file-autoloads (file)
"Insert at point an autoload section for FILE.
autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
＠＠ -291,26 +329,26 ＠＠
are used."
(interactive "fGenerate autoloads for file: ")
(cond ((string-match "\\.el$" file)
- (generate-autoload-ish-1
+ (generate-autoload-type-section
file
(replace-in-string (file-name-nondirectory file) "\\.elc?$" "")
- nil #'generate-file-autoloads-1
- funlist))
+ nil #'generate-lisp-file-autoloads-1))
;; #### jj, are C++ modules possible?
((string-match "\\.c$" file)
- (generate-autoload-ish-1
+ (generate-autoload-type-section
file
(replace-in-string (file-name-nondirectory file) "\\.c$" "")
- t #'generate-c-file-autoloads-1
- funlist))
+ t #'generate-c-file-autoloads-1))
(t
(error 'wrong-type-argument file "not a C or Elisp source file"))))
-(defun* generate-autoload-ish-1 (file load-name literal fun-to-call &rest args)
+(defun* generate-autoload-type-section (file load-name literal fun-to-call)
"Insert at point an autoload-type section for FILE.
-If LITERAL, open the file literally, without decoding.
-Calls FUN-TO-CALL to compute the autoloads, passing it OUTBUF, LOAD-NAME,
- TRIM-NAME, and ARGS."
+LOAD-NAME is the non-directory portion of the name, with the final .el, .elc
+or .c section removed. If LITERAL, open the file literally, without decoding.
+Calls FUN-TO-CALL to compute the autoloads, with the loaded file in the
+current buffer, passing it OUTBUF (where to write the autoloads), LOAD-NAME,
+and TRIM-NAME (result of calling `autoload-trim-file-name' on FILE)."
(let ((outbuf (current-buffer))
(trim-name (autoload-trim-file-name file))
(autoloads-done '())
＠＠ -318,6 +356,7 ＠＠
(print-readably t) ; XEmacs
(float-output-format nil)
(visited (get-file-buffer file))
+ suppress-form
;; (done-any nil)
output-end)
＠＠ -329,21 +368,74 ＠＠
;; subdirectory of the current buffer's directory, we'll make it
;; relative to the current buffer's directory.
(setq file (expand-file-name file))
-
+ ;; #### FSF 21.2. Do we want this?
+; (let* ((source-truename (file-truename file))
+; (dir-truename (file-name-as-directory
+; (file-truename default-directory)))
+; (len (length dir-truename)))
+; (if (and (< len (length source-truename))
+; (string= dir-truename (substring source-truename 0 len)))
+; (setq file (substring source-truename len))))
+
+ ;; Check for suppression form (XEmacs)
+ (let* ((dir (file-name-directory file))
+ (_pkg (expand-file-name "_pkg.el" dir))
+ (pkg-vis (get-file-buffer _pkg))
+ pkg-buf)
(save-excursion
+ (when (file-readable-p _pkg)
(unwind-protect
(progn
(let ((find-file-hooks nil)
(enable-local-variables nil))
+ (set-buffer (or pkg-vis (find-file-noselect _pkg)))
+ (set-syntax-table emacs-lisp-mode-syntax-table))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (block nil
+ (while (search-forward "(package-suppress" nil t)
+ ;; skip over package-name
+ (forward-sexp 1)
+ (let ((supfile (read (current-buffer))))
+ (when (equal supfile load-name)
+ (setq suppress-form (eval (read (current-buffer))))
+ (return))))))))
+ (unless pkg-vis
+ ;; We created this buffer, so we should kill it.
+ (if pkg-buf (kill-buffer pkg-buf)))))))
+
+ (save-excursion
+ (unwind-protect
+ (progn
+ (let (;(find-file-hooks nil)
+ ;(enable-local-variables nil)
+ )
(set-buffer (or visited (find-file-noselect file literal literal
)))
;; This doesn't look right for C files, but it is. The only
;; place we need the syntax table is when snarfing the Lisp
;; function name.
(set-syntax-table emacs-lisp-mode-syntax-table))
+; (if visited
+; (set-buffer visited)
+; ;; It is faster to avoid visiting the file.
+; (set-buffer (get-buffer-create " *generate-autoload-file*"))
+; (kill-all-local-variables)
+; (erase-buffer)
+; (setq buffer-undo-list t
+; buffer-read-only nil)
+; ;; This doesn't look right for C files, but it is. The only
+; ;; place we need the syntax table is when snarfing the Lisp
+; ;; function name.
+; (emacs-lisp-mode)
+; (if literal
+; (insert-file-contents-literally file nil)
+; (insert-file-contents file nil)))
(unless (setq autoloads-done
- (apply fun-to-call outbuf load-name trim-name args))
- (return-from generate-autoload-ish-1))
+ (funcall fun-to-call outbuf load-name trim-name))
+ (return-from generate-autoload-type-section))
)
(unless visited
;; We created this buffer, so we should kill it.
＠＠ -354,84 +446,63 ＠＠
;; XEmacs -- always do this so that we cache the information
;; that we've processed the file already.
(progn
+ ;; Insert the section-header line
+ ;; which lists the file name and which functions are in it, etc.
(insert generate-autoload-section-header)
- (prin1 (list 'autoloads autoloads-done load-name trim-name)
+ (prin1 (list 'autoloads autoloads-done load-name trim-name
+ ;; In FSF 21.2. Also in FSF 19.30. Presumably
+ ;; deleted from XEmacs.
+ ;; (nth 5 (file-attributes file))
+ )
outbuf)
(terpri outbuf)
- ;;;; (insert ";;; Generated autoloads from "
- ;;;; (autoload-trim-file-name file) "\n")
- ;; Warn if we put a line in auto-autoloads.el
- ;; that is long enough to cause trouble.
- (when (< output-end (point))
- (setq output-end (point-marker)))
- (while (< (point) output-end)
- ;; (let ((beg (point)))
- (end-of-line)
- ;; Emacs -- I still haven't figured this one out.
- ;; (if (> (- (point) beg) 900)
- ;; (progn
- ;; (message "A line is too long--over 900 characters")
- ;; (sleep-for 2)
- ;; (goto-char output-end)))
- ;; )
- (forward-line 1))
+ ;; #### Alas, we will have to think about this. Adding this means
+ ;; that, once we have created or maintained an auto-autoloads file,
+ ;; we alone and our successors can update the file. The file itself
+ ;; will work fine in older XEmacsen, but they won't be able to
+ ;; update autoloads -- hence, to build.
+; ;; Break that line at spaces, to avoid very long lines.
+; ;; Make each sub-line into a comment.
+; (with-current-buffer outbuf
+; (save-excursion
+; (forward-line -1)
+; (while (not (eolp))
+; (move-to-column 64)
+; (skip-chars-forward "^ \n")
+; (or (eolp)
+; (insert "\n" generate-autoload-section-continuation)))))
+ ;; XEmacs: This was commented out before. #### Correct?
+; (insert ";;; Generated autoloads from "
+; (autoload-trim-file-name file) "\n")
+ ;; XEmacs -- handle suppression
+ (when suppress-form
+ (insert "\n;;; Suppress form from _pkg.el\n")
+ (insert "(unless " (prin1-to-string suppress-form) "\n\n"))
(goto-char output-end)
+ ;; XEmacs -- handle suppression
+ (when suppress-form
+ (insert "\n) ;; unless (suppressed)\n"))
(insert generate-autoload-section-trailer)))
- (or noninteractive ; XEmacs: only need one line in -batch mode.
- (message "Generating autoloads for %s...done" file))))
+ ))
-(defun* generate-file-autoloads-1 (outbuf load-name trim-name funlist)
- "Insert at point an autoload section for FILE.
-autoloads are generated for defuns and defmacros in FILE
-marked by `generate-autoload-cookie' (which see).
-If FILE is being visited in a buffer, the contents of the buffer
-are used."
- (let ((autoloads-done '())
- (dofiles (not (null funlist)))
- )
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (unless (search-forward generate-autoload-cookie nil t)
- (message "No autoloads found in %s" trim-name)
- (return-from generate-file-autoloads-1 nil))
-
- (message "Generating autoloads for %s..." trim-name)
- (goto-char (point-min))
- (while (if dofiles funlist (not (eobp)))
- (if (not dofiles)
- (skip-chars-forward " \t\n\f")
- (goto-char (point-min))
- (re-search-forward
- (concat "(def\\(un\\|var\\|const\\|macro\\) "
- (regexp-quote (symbol-name (car funlist)))
- "\\s "))
- (goto-char (match-beginning 0)))
- (cond
- ((or dofiles
- (looking-at (regexp-quote generate-autoload-cookie)))
- (if dofiles
- nil
- (search-forward generate-autoload-cookie)
- (skip-chars-forward " \t"))
+(defun process-one-lisp-autoload (autoloads-done outbuf load-name)
+ "Process a single autoload at point and write to OUTBUF.
+Point should be just after a magic cookie string (e.g. ;;;###autoload).
+Updates AUTOLOADS-DONE and returns the new value."
+ (skip-chars-forward " \t")
;; (setq done-any t)
- (if (or dofiles (eolp))
+ (if (eolp)
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
- (autoload (make-autoload form load-name))
- (doc-string-elt (get (car-safe form)
- 'doc-string-elt)))
+ (autoload (make-autoload form load-name)))
(if autoload
(setq autoloads-done (cons (nth 1 form)
autoloads-done))
(setq autoload form))
- (print-autoload autoload doc-string-elt outbuf ""))
+ (autoload-print-form autoload outbuf ""))
;; Copy the rest of the line to the output.
- (let ((begin (point)))
- ;; (terpri outbuf)
(cond ((looking-at "immediate\\s *$") ; XEmacs
;; This is here so that you can automatically
;; have small hook functions copied to
＠＠ -439,23 +510,60 ＠＠
;; to load a whole file just to get a two-line
;; do-nothing find-file-hook... --Stig
(forward-line 1)
- (setq begin (point))
+ (let ((begin (point)))
(forward-sexp)
- (forward-line 1))
+ (forward-line 1)
+ (princ (buffer-substring begin (point)) outbuf)))
(t
- (forward-line 1)))
- (princ (buffer-substring begin (point)) outbuf))))
+ (princ (buffer-substring
+ (progn
+ ;; Back up over whitespace, to preserve it.
+ (skip-chars-backward " \f\t")
+ (if (= (char-after (1+ (point))) ? )
+ ;; Eat one space.
+ (forward-char 1))
+ (point))
+ (progn (forward-line 1) (point)))
+ outbuf))))
+ autoloads-done)
+
+(defun* generate-lisp-file-autoloads-1 (outbuf load-name trim-name)
+ "Insert at point in OUTBUF an autoload section for an Elisp file.
+The file is assumed to be already loaded and in the current buffer.
+autoloads are generated for defuns and defmacros marked by
+`generate-autoload-cookie' (which see)."
+ (let ((autoloads-done '())
+ )
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (search-forward generate-autoload-cookie nil t)
+ (message "No autoloads found in %s" trim-name)
+ (return-from generate-lisp-file-autoloads-1 nil))
+
+ (message "Generating autoloads for %s..." trim-name)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n\f")
+ (cond
+ ((looking-at (regexp-quote generate-autoload-cookie))
+ (search-forward generate-autoload-cookie)
+ (setq autoloads-done
+ (process-one-lisp-autoload autoloads-done outbuf load-name)))
((looking-at ";")
;; Don't read the comment.
(forward-line 1))
(t
(forward-sexp 1)
(forward-line 1)))
- (if dofiles
- (setq funlist (cdr funlist))))))
+ )))
+ (or noninteractive ; XEmacs: only need one line in -batch mode.
+ (message "Generating autoloads for %s...done" trim-name))
autoloads-done))
-(defun* generate-c-file-autoloads-1 (outbuf load-name trim-name funlist)
+(defun* generate-c-file-autoloads-1 (outbuf load-name trim-name
+ &optional funlist)
"Insert at point an autoload section for the C file FILE.
autoloads are generated for defuns and defmacros in FILE
marked by `generate-c-autoload-cookie' (which see).
＠＠ -488,7 +596,7 ＠＠
(let ((autoload (make-c-autoload load-name)))
(when autoload
(push (nth 1 (nth 1 autoload)) autoloads-done)
- (print-autoload autoload 3 outbuf " "))))
+ (autoload-print-form autoload outbuf " "))))
;; close the princ'd `when' form
(princ ")" outbuf))
(goto-char (point-min))
＠＠ -505,23 +613,107 ＠＠
(let ((autoload (make-c-autoload load-name)))
(when autoload
(push (nth 1 (nth 1 autoload)) autoloads-done)
- (print-autoload autoload 3 outbuf " ")))
+ (autoload-print-form autoload outbuf " ")))
(setq match
(search-forward generate-c-autoload-cookie nil t)))
;; close the princ'd `when' form
(princ ")" outbuf)))))
+ (or noninteractive ; XEmacs: only need one line in -batch mode.
+ (message "Generating autoloads for %s...done" trim-name))
+ autoloads-done))
+
+;;;###autoload
+(defun generate-custom-defines (file)
+ "Insert at point a custom-define section for FILE.
+If FILE is being visited in a buffer, the contents of the buffer
+are used."
+ (interactive "fGenerate custom defines for file: ")
+ (cond ((string-match "\\.el$" file)
+ (generate-autoload-type-section
+ file
+ (replace-in-string (file-name-nondirectory file) "\\.elc?$" "")
+ nil #'generate-custom-defines-1))
+ ((string-match "\\.c$" file)
+ ;; no way to generate custom-defines for C files (currently?),
+ ;; but cannot signal an error.
+ nil)
+ (t
+ (error 'wrong-type-argument file "not a C or Elisp source file"))))
+
+(defun* generate-custom-defines-1 (outbuf load-name trim-name)
+ "Insert at point in OUTBUF a custom-define section for an Elisp file.
+This contains all defcustoms and defgroups in the file.
+The file is assumed to be already loaded and in the current buffer."
+ (let* ((search-regexp-1 "^(\\(defcustom\\|defgroup\\) ")
+ (search-string-2 ";;;###custom-define")
+ (search-regexp-2 (regexp-quote search-string-2))
+ (autoloads-done '()))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (or (re-search-forward search-regexp-1 nil t)
+ (re-search-forward search-regexp-2 nil t))
+ (message "No custom defines found in %s" trim-name)
+ (return-from generate-custom-defines-1 nil))
+ (message "Generating custom defines for %s..." trim-name)
+ (princ "(defconst custom-define-current-source-file " outbuf)
+ (prin1 (file-relative-name (buffer-file-name)
+ (symbol-value-in-buffer 'default-directory
+ outbuf)) outbuf)
+ (princ ")\n" outbuf)
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n\f")
+ (cond
+ ((looking-at search-regexp-1)
+ ;; Read the next form and copy it to make an autoload.
+ (let* ((form (prog1 (read (current-buffer))
+ (or (bolp) (forward-line 1))))
+ (autoload form ;(make-autoload form load-name)
+ ))
+ (if autoload
+ (setq autoloads-done (cons (nth 1 form)
autoloads-done))
+ (setq autoload form))
+ (autoload-print-form autoload outbuf ""))
+ )
+ ((looking-at search-regexp-2)
+ (search-forward search-string-2)
+ (beep)
+ (setq autoloads-done
+ (process-one-lisp-autoload autoloads-done outbuf load-name)))
+ ((looking-at ";")
+ ;; Don't read the comment.
+ (forward-line 1))
+ (t
+ (forward-sexp 1)
+ (forward-line 1)))
+ )))
+ (or noninteractive ; XEmacs: only need one line in -batch mode.
+ (message "Generating custom defines for %s...done" trim-name))
+ autoloads-done))
;; Assorted utilities for generating autoloads and pieces thereof
-(defun print-autoload (autoload doc-string-elt outbuf margin)
+(defun autoload-print-form (form outbuf margin)
"Print an autoload form, handling special characters.
In particular, print docstrings with escapes inserted before left parentheses
at the beginning of lines and ^L characters."
- (if (and doc-string-elt (stringp (nth doc-string-elt autoload)))
+ (cond
+ ;; If the form is a sequence, recurse.
+ ((eq (car form) 'progn)
+ (mapcar #'(lambda (x) (autoload-print-form x outbuf margin))
+ (cdr form)))
+ ;; Symbols at the toplevel are meaningless.
+ ((symbolp form) nil)
+ (t
+ (let ((doc-string-elt (get (car-safe form) 'doc-string-elt)))
+ (if (and doc-string-elt (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the doc-string must be
;; printed specially for make-docfile (sigh).
- (let* ((p (nthcdr (1- doc-string-elt) autoload))
+ (let* ((p (nthcdr (1- doc-string-elt) form))
(elt (cdr p))
(start-string (format "\n%s(" margin)))
(setcdr p nil)
＠＠ -529,16 +721,14 ＠＠
;; XEmacs change: don't let ^^L's get into
;; the file or sorting is hard.
(let ((print-escape-newlines t)
- (p (save-excursion
- (set-buffer outbuf)
- (point)))
+ ;;#### FSF 21.2 (print-escape-nonascii t)
+ (p (point outbuf))
p2)
(mapcar #'(lambda (elt)
(prin1 elt outbuf)
(princ " " outbuf))
- autoload)
- (save-excursion
- (set-buffer outbuf)
+ form)
+ (with-current-buffer outbuf
(setq p2 (point-marker))
(goto-char p)
(save-match-data
＠＠ -547,14 +737,11 ＠＠
(insert "\\^L")))
(goto-char p2)))
(princ "\"\\\n" outbuf)
- (let ((begin (save-excursion
- (set-buffer outbuf)
- (point))))
+ (let ((begin (point outbuf)))
(princ (substring (prin1-to-string (car elt)) 1) outbuf)
;; Insert a backslash before each ( that appears at the beginning
;; of a line in the doc string.
- (save-excursion
- (set-buffer outbuf)
+ (with-current-buffer outbuf
(save-excursion
(while (search-backward start-string begin t)
(forward-char 1)
＠＠ -566,30 +753,35 ＠＠
(terpri outbuf)
(princ margin outbuf)))
;; XEmacs change: another ^L hack
- (let ((p (save-excursion
- (set-buffer outbuf)
- (point)))
+ (let ((p (point outbuf))
(print-escape-newlines t)
+ ;;#### FSF 21.2 (print-escape-nonascii t)
p2)
- (print autoload outbuf)
- (save-excursion
- (set-buffer outbuf)
+ (print form outbuf)
+ (with-current-buffer outbuf
(setq p2 (point-marker))
(goto-char p)
(save-match-data
(while (search-forward "\^L" p2 t)
(delete-char -1)
(insert "\\^L")))
- (goto-char p2)))))
+ (goto-char p2))))))))
;;; Forms which have doc-strings which should be printed specially.
;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
;;; the doc-string in FORM.
;;;
-;;; defvar and defconst should be also be marked in this way. There is
-;;; no interference from make-docfile, which only processes those files
-;;; that are loaded into the dumped Emacs, and those files should
-;;; never have anything autoloaded here. Problems only occur with files
+;;; There used to be the following note here:
+;;; ;;; Note: defconst and defvar should NOT be marked in this way.
+;;; ;;; We don't want to produce defconsts and defvars that
+;;; ;;; make-docfile can grok, because then it would grok them twice,
+;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
+;;; ;;; once in loaddefs.el.
+;;;
+;;; Counter-note: Yes, they should be marked in this way.
+;;; make-docfile only processes those files that are loaded into the
+;;; dumped Emacs, and those files should never have anything
+;;; autoloaded here. The above-feared problem only occurs with files
;;; which have autoloaded entries *and* are processed by make-docfile;
;;; there should be no such files.
＠＠ -597,11 +789,18 ＠＠
(put 'defun 'doc-string-elt 3)
(put 'defun* 'doc-string-elt 3)
(put 'defvar 'doc-string-elt 3)
+(put 'defcustom 'doc-string-elt 3)
(put 'defconst 'doc-string-elt 3)
(put 'defmacro 'doc-string-elt 3)
(put 'defmacro* 'doc-string-elt 3)
-(put 'define-skeleton 'doc-string-elt 3)
+(put 'defsubst 'doc-string-elt 3)
+(put 'define-skeleton 'doc-string-elt 2)
(put 'define-derived-mode 'doc-string-elt 4)
+(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
+(put 'define-minor-mode 'doc-string-elt 2)
+(put 'define-generic-mode 'doc-string-elt 7)
+;; defin-global-mode has no explicit docstring.
+(put 'easy-mmode-define-global-mode 'doc-string-elt 1000)
(defun autoload-trim-file-name (file)
"Returns relative pathname of FILE including the last directory.
＠＠ -615,6 +814,27 ＠＠
;; #### is this a good idea?
"\\\\" "/"))
+(defun autoload-read-section-header ()
+ "Read a section header form.
+Since continuation lines have been marked as comments,
+we must copy the text of the form and remove those comment
+markers before we call `read'."
+ (save-match-data
+ (let ((beginning (point))
+ string)
+ (forward-line 1)
+ (while (looking-at generate-autoload-section-continuation)
+ (forward-line 1))
+ (setq string (buffer-substring beginning (point)))
+ (with-current-buffer (get-buffer-create " *autoload*")
+ (erase-buffer)
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward generate-autoload-section-continuation nil t)
+ (replace-match " "))
+ (goto-char (point-min))
+ (read (current-buffer))))))
+
;;;###autoload
(defun update-file-autoloads (file)
"Update the autoloads for FILE in `generated-autoload-file'
＠＠ -633,16 +853,42 ＠＠
(trim-name (autoload-trim-file-name file))
section-begin form)
(save-excursion
+ ;; FSF has: [[ We want to get a value for generated-autoload-file
+ ;; from the local variables section if it's there. ]] Not
+ ;; applicable in XEmacs, since we always keep the autoloads
+ ;; up-to-date.
+
+ ;; #### FSF 21.2 adds: [[ We must read/write the file without any
+ ;; code conversion, but still decode EOLs. ]] Not clear if we need
+ ;; this. --ben
+ ;; (let ((coding-system-for-read 'raw-text))
(let ((find-file-hooks nil))
(set-buffer (or (get-file-buffer generated-autoload-file)
(find-file-noselect generated-autoload-file))))
+ ;; FSF 21.2 says:
+
+ ;; [[ This is to make generated-autoload-file have Unix EOLs, so
+ ;; that it is portable to all platforms. ]]
+ ;; (setq buffer-file-coding-system 'raw-text-unix))
+ ;; Not applicable in XEmacs, since we always keep the autoloads
+ ;; up-to-date and recompile when we build.
+
+ ;; FSF 21.2: [not applicable to XEmacs]
+; (or (> (buffer-size) 0)
+; (error "Autoloads file %s does not exist" buffer-file-name))
+; (or (file-writable-p buffer-file-name)
+; (error "Autoloads file %s is not writable" buffer-file-name))
+
+ ;; NOTE: The rest of this function is totally changed from FSF.
+ ;; Hence, not synched.
+
;; Make sure we can scribble in it.
(setq buffer-read-only nil)
;; First delete all sections for this file.
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(setq section-begin (match-beginning 0))
- (setq form (read (current-buffer)))
+ (setq form (autoload-read-section-header))
(when (string= (nth 2 form) load-name)
(search-forward generate-autoload-section-trailer)
(delete-region section-begin (point))))
＠＠ -651,7 +897,7 ＠＠
(block find-insertion-point
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
- (setq form (read (current-buffer)))
+ (setq form (autoload-read-section-header))
(when (string< trim-name (nth 3 form))
;; Found alphabetically correct insertion point
(goto-char (match-beginning 0))
＠＠ -661,65 +907,15 ＠＠
(goto-char (point-max)))) ; Append.
;; Add in new sections for file
- (generate-file-autoloads file))
+ (funcall generate-autoload-function file))
(when (interactive-p) (save-buffer)))))
-;;;###autoload
-(defun update-autoloads-here ()
- "Update sections of the current buffer generated by
`update-file-autoloads'."
- (interactive)
- (let ((generated-autoload-file (buffer-file-name)))
- (save-excursion
- (goto-char (point-min))
- (while (search-forward generate-autoload-section-header nil t)
- (let* ((form (condition-case ()
- (read (current-buffer))
- (end-of-file nil)))
- (file (nth 3 form)))
- ;; XEmacs change: if we can't find the file as specified, look
- ;; around a bit more.
- (cond ((and (stringp file)
- (or (get-file-buffer file)
- (file-exists-p file))))
- ((and (stringp file)
- (save-match-data
- (let ((loc (locate-file (file-name-nondirectory file)
- load-path)))
- (if (null loc)
- nil
- (setq loc (expand-file-name
- (autoload-trim-file-name loc)
- ".."))
- (if (or (get-file-buffer loc)
- (file-exists-p loc))
- (setq file loc)
- nil))))))
- (t
- (setq file
- (if (y-or-n-p
- (format
- "Can't find library `%s'; remove its autoloads? "
- (nth 2 form) file))
- t
- (condition-case ()
- (read-file-name
- (format "Find `%s' load file: "
- (nth 2 form))
- nil nil t)
- (quit nil))))))
- (if file
- (let ((begin (match-beginning 0)))
- (search-forward generate-autoload-section-trailer)
- (delete-region begin (point))))
- (if (stringp file)
- (generate-file-autoloads file)))))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utilities for batch updates
;;;###autoload
-(defun autoload-update-directory-autoloads ()
+(defun batch-update-directory-autoloads ()
"Update the autoloads for a directory, using a specified feature prefix.
Must be used only with -batch. The feature prefix and directory to update
are taken from the first and second elements of `command-line-args-left',
＠＠ -730,16 +926,33 ＠＠
applying `autoload-make-feature-name' to the specified feature prefix.
#### The API and semantics of this function are subject to change."
+ (unless noninteractive
+ (error "batch-update-directory-autoloads: may be used only with
-batch"))
+ (update-autoload-files (list (cadr command-line-args-left))
+ (car command-line-args-left) nil t)
+ (setq command-line-args-left (cddr command-line-args-left)))
+
+;;;###autoload
+(defun batch-update-directory-custom-defines ()
+ "Update the custom defines for a directory, using a specified feature prefix.
+Must be used only with -batch. The feature prefix and directory to update
+are taken from the first and second elements of `command-line-args-left',
+respectively, and they are then removed from `command-line-args-left'.
+
+Runs `update-file-autoloads' on each file in the given directory. Always
+rewrites the autoloads file, even if unchanged. Makes a feature name by
+applying `autoload-make-feature-name' to the specified feature prefix.
+
+#### The API and semantics of this function are subject to change."
(unless noninteractive
- (error "autoload-batch-update-autoloads: may be used only with -batch"))
- (let* ((autoload-feature-prefix (car command-line-args-left))
- (dir (cadr command-line-args-left))
- (generated-autoload-file (expand-file-name autoload-file-name dir)))
- (update-autoload-files (list dir) t t)
- (setq command-line-args-left (cddr command-line-args-left))))
+ (error "batch-update-directory-custom-defines: may be used only with
-batch"))
+ (update-custom-define-files (list (cadr command-line-args-left))
+ (car command-line-args-left) nil t)
+ (setq command-line-args-left (cddr command-line-args-left)))
;;;###autoload
-(defun update-autoload-files (files-or-dirs &optional all-into-one-file force)
+(defun update-autoload-files (files-or-dirs feature-prefix
+ &optional into-file force)
"Update all the autoload files associated with FILES-OR-DIRS.
FILES-OR-DIRS is a list of files and/or directories to be processed.
＠＠ -747,61 +960,41 ＠＠
each element of FILES-OR-DIRS. Fixup code testing for the autoload file's
feature and to provide the feature is added.
-If optional ALL-INTO-ONE-FILE is non-`nil', `generated-autoload-file'
-should be set to the name of an autoload file and all autoloads will be
-placed in that file. `autoload-feature-prefix' should be set to an
-appropriate prefix which will be concatenated with \"-autoloads\" to
-produce the feature name. Otherwise the appropriate autoload file for
-each file or directory (located in that directory, or in the directory of
-the specified file) will be updated with the directory's or file's
-autoloads and the protective forms will be added, and the files will be
-saved. Use of the default here is unreliable, and therefore deprecated.
+If optional INTO-FILE is non-`nil', it should specify a file into which
+the autoloads will be placed. Otherwise, the autoloads will be placed into
+a file named `auto-autoloads.el' in the directory of each element in
+FILES-OR-DIRS.
+
+FEATURE-PREFIX should be set to an appropriate prefix which will
+be concatenated with \"-autoloads\" to produce the feature name. Otherwise
+the appropriate autoload file for each file or directory (located in that
+directory, or in the directory of the specified file) will be updated with
+the directory's or file's autoloads and the protective forms will be added,
+and the files will be saved. Use of the default here is unreliable, and
+therefore deprecated.
Note that if some of FILES-OR-DIRS are directories, recursion goes only
one level deep.
If FORCE is non-nil, always save out the autoload files even if unchanged."
+ (or (listp files-or-dirs) (setq files-or-dirs (list files-or-dirs)))
(let ((defdir (directory-file-name default-directory))
;; value for all-into-one-file
- (autoload-feature-name (autoload-make-feature-name))
- (enable-local-eval nil)) ; Don't query in batch mode.
+ (autoload-feature-name (autoload-make-feature-name feature-prefix))
+ (enable-local-eval nil) ; Don't query in batch mode.
+ (autoload-feature-prefix feature-prefix)
+ ;; protect from change
+ (generated-autoload-file generated-autoload-file))
(dolist (arg files-or-dirs)
(setq arg (expand-file-name arg defdir))
(cond
((file-directory-p arg)
+ (setq generated-autoload-file
+ (or into-file (expand-file-name autoload-file-name arg)))
(message "Updating autoloads for directory %s..." arg)
- (update-autoloads-from-directory arg))
- ((file-exists-p arg)
- (update-file-autoloads arg))
- (t (error "No such file or directory: %s" arg)))
- (when (not all-into-one-file)
- (autoload-featurep-protect-autoloads
- (autoload-make-feature-name
- (file-name-nondirectory (directory-file-name arg))))
- (if force (set-buffer-modified-p
- t (find-file-noselect generated-autoload-file)))))
- (when all-into-one-file
- (autoload-featurep-protect-autoloads autoload-feature-name)
- (if force (set-buffer-modified-p
- t (find-file-noselect generated-autoload-file))))
- (save-some-buffers t)
- ))
-
-;;;###autoload
-(defun update-autoloads-from-directory (dir)
- "Update `generated-autoload-file' with all the current autoloads from DIR.
-This runs `update-file-autoloads' on each .el and .c file in DIR.
-Obsolete autoload entries for files that no longer exist are deleted.
-Note that, if this function is called from `batch-update-directory',
-`generated-autoload-file' was rebound in that function.
-
-You don't really want to be calling this function. Try using
-`update-autoload-files' instead."
- (interactive "DUpdate autoloads for directory: ")
- (setq dir (expand-file-name dir))
(let ((simple-dir (file-name-as-directory
(file-name-nondirectory
- (directory-file-name dir))))
+ (directory-file-name arg))))
(enable-local-eval nil))
(save-excursion
(let ((find-file-hooks nil))
＠＠ -809,36 +1002,102 ＠＠
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((begin (match-beginning 0))
- (form (condition-case ()
- (read (current-buffer))
- (end-of-file nil)))
+ (form (autoload-read-section-header))
(file (nth 3 form)))
(when (and (stringp file)
(string= (file-name-directory file) simple-dir)
(not (file-exists-p
(expand-file-name
- (file-name-nondirectory file) dir))))
+ (file-name-nondirectory file) arg))))
;; Remove the obsolete section.
(search-forward generate-autoload-section-trailer)
(delete-region begin (point)))))
;; Update or create autoload sections for existing files.
(mapcar 'update-file-autoloads
- (directory-files dir t "^[^=].*\\.\\(el\\|c\\)$"))
- (unless noninteractive
- (save-buffer)))))
+ (directory-files arg t "^[^=].*\\.\\(el\\|c\\)$")))))
+ ((file-exists-p arg)
+ (setq generated-autoload-file
+ (or into-file (expand-file-name autoload-file-name
+ (file-name-directory arg))))
+ (update-file-autoloads arg))
+ (t (error "No such file or directory: %s" arg)))
+ (when (not into-file)
+ (autoload-featurep-protect-autoloads
+ (autoload-make-feature-name
+ (or feature-prefix
+ (file-name-nondirectory (directory-file-name arg)))))
+ (if force (set-buffer-modified-p
+ t (find-file-noselect generated-autoload-file)))))
+ (when into-file
+ (autoload-featurep-protect-autoloads autoload-feature-name)
+ (if force (set-buffer-modified-p
+ t (find-file-noselect into-file))))
+ (save-some-buffers t)
+ ))
+;;;###autoload
+(defun update-custom-define-files (files-or-dirs feature-prefix
+ &optional into-file force)
+ "Update all the custom-define files associated with FILES-OR-DIRS.
+Works just like `update-file-autoloads'."
+ (let* ((autoload-feature-suffix "-custom-defines")
+ (autoload-file-name "custom-defines.el")
+ (generate-autoload-function #'generate-custom-defines))
+ (update-autoload-files files-or-dirs feature-prefix into-file force)))
+
(defun autoload-featurep-protect-autoloads (sym)
(save-excursion
(set-buffer (find-file-noselect generated-autoload-file))
+ (goto-char (point-min))
+ (cond ((eq (point-min) (point-max)) nil)
+ ;; if there's some junk in the file but no sections, just
+ ;; delete everything. the junk might be stuff inserted by
+ ;; an older version of this function.
+ ((not (search-forward generate-autoload-section-header nil t))
+ (delete-region (point-min) (point-max)))
+ (t
(goto-char (point-min))
- (if (and (not (= (point-min) (point-max)))
- (not (looking-at ";;; DO NOT MODIFY THIS FILE")))
+ (when (looking-at ";;; DO NOT MODIFY THIS FILE")
+ (delete-region (point-min)
(progn
- (insert ";;; DO NOT MODIFY THIS FILE\n")
- (insert "(if (featurep '" sym ")")
+ (search-forward generate-autoload-section-header)
+ (match-beginning 0))))
+ ;; Determine and set the coding system for the file if under Mule.
+ ;; If there are any extended characters in the input file, use
+ ;; `escape-quoted' to make sure that both binary and extended
+ ;; characters are output properly and distinguished properly.
+ ;; Otherwise, use `raw-text' for maximum portability with non-Mule
+ ;; Emacsen.
+ (if (or (featurep '(not mule)) ;; Don't scan if no Mule support
+ (progn
+ (goto-char (point-min))
+ ;; mrb- There must be a better way than skip-chars-forward
+ (skip-chars-forward (concat (char-to-string 0) "-"
+ (char-to-string 255)))
+ (eq (point) (point-max))))
+ (setq buffer-file-coding-system 'raw-text-unix)
+ (setq buffer-file-coding-system 'escape-quoted))
+ (goto-char (point-min))
+ (insert ";;; DO NOT MODIFY THIS FILE")
+ ;; NOTE: XEmacs prior to 21.5.12 or so had a bug in that it
+ ;; recognized only one of the two magic-cookie styles (the -*- kind)
+ ;; in find-file, but both of them in load. We go ahead and put both
+ ;; in, just to be safe.
+ (when (eq buffer-file-coding-system 'escape-quoted)
+ (insert " -*- coding: escape-quoted; -*-
+\(or (featurep 'mule) (error \"Loading this file requires Mule
support\"))
+;;;###coding system: escape-quoted"))
+ (insert "\n(if (featurep '" sym ")")
(insert " (error \"Feature " sym " already
loaded\"))\n")
(goto-char (point-max))
- (insert "\n(provide '" sym ")\n")))))
+ (save-excursion
+ (forward-line -1)
+ (when (looking-at "(provide")
+ (delete-region (point) (point-max))))
+ (unless (bolp) (insert "\n"))
+ (unless (eq (char-before (1- (point))) ?\^L)
+ (insert "\^L\n"))
+ (insert "(provide '" sym ")\n")))))
(defun autoload-make-feature-name (&optional prefix)
"Generate the feature name to protect this auto-autoloads file from PREFIX.
＠＠ -864,19 +1123,23 ＠＠
(file-name-directory generated-autoload-file))))
(t (error 'invalid-argument
"Could not compute a feature name")))
- "-autoloads"))
+ autoload-feature-suffix))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Deprecated entry points
;; A grep of the core and packages shows use of `batch-update-autoloads'
;; by XEmacs.rules, pcomplete, eshell, oort-gnus; `batch-update-directory'
-;; by liece.
+;; by liece. The other two entry points (`batch-update-one-directory',
+;; `batch-force-update-one-directory') were not used at all.
+;;
+;; All except the first are now history. liece has been updated.
+;; XEmacs.rules has been updated. The others will be, eventually.
+
+;; There don't seem to be very many packages that use the first one (the
+;; "all-into-one-file" variety), and do they actually rely on this
+;; functionality? --ben
-;; #### these entry points below are a big mess, especially the
-;; first two. there don't seem to be very many packages that use the
-;; first one (the "all-into-one-file" variety), and do they actually
-;; rely on this functionality? --ben
;; but XEmacs.rules does, though maybe it doesn't "rely" on it, and
;; modules do now, and that relies on it. --sjt
＠＠ -891,58 +1154,14 ＠＠
on the command line."
(unless noninteractive
(error "batch-update-autoloads is to be used only with -batch"))
- (update-autoload-files command-line-args-left t)
+ (update-autoload-files command-line-args-left generated-autoload-file)
(kill-emacs 0))
-;;;###autoload
-(defun batch-update-directory ()
- "Update the autoloads for the directories on the command line.
-Runs `update-file-autoloads' on each file in the given directory, and must
-be used only with -batch.
-
-Uses and removes the first element of `command-line-args-left'."
- (unless noninteractive
- (error "batch-update-directory is to be used only with -batch"))
- (update-autoload-files command-line-args-left)
- ;; (kill-emacs 0)
- (setq command-line-args-left nil))
-
-;;;###autoload
-(defun batch-update-one-directory ()
- "Update the autoloads for a single directory on the command line.
-Runs `update-file-autoloads' on each file in the given directory, and must
-be used only with -batch."
- (unless noninteractive
- (error "batch-update-one-directory is to be used only with -batch"))
- (let ((arg (car command-line-args-left)))
- (setq command-line-args-left (cdr command-line-args-left))
- (update-autoload-files (list arg))))
-
-;;;###autoload
-(defun batch-force-update-one-directory ()
- "Update the autoloads for a single directory on the command line.
-Runs `update-file-autoloads' on each file in the given directory, and must
-be used only with -batch. Always rewrites the autoloads file, even if
-unchanged.
-
-Uses and removes the first element of `command-line-args-left'."
- (unless noninteractive
- (error "batch-force-update-directory is to be used only with -batch"))
- (let ((arg (car command-line-args-left)))
- (setq command-line-args-left (cdr command-line-args-left))
- (update-autoload-files (list arg) nil t)))
-
;; Declare obsolescence
(make-obsolete-variable 'autoload-target-directory
"Don't use this. Bind `generated-autoload-file' to an absolute
path.")
(make-obsolete 'batch-update-autoloads
- 'autoload-update-directory-autoloads)
-(make-obsolete 'batch-update-directory
- 'autoload-update-directory-autoloads)
-(make-obsolete 'batch-update-one-directory
- 'autoload-update-directory-autoloads)
-(make-obsolete 'batch-force-update-one-directory
'autoload-update-directory-autoloads)
(provide 'autoload)
1.35 +3 -3 XEmacs/xemacs/lisp/update-elc.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: update-elc.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/update-elc.el,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -b -r1.34 -r1.35
--- update-elc.el 2004/12/27 12:25:15 1.34
+++ update-elc.el 2005/02/03 07:11:20 1.35
＠＠ -106,7 +106,7 ＠＠
;; early byte compilation. These are files loaded by update-elc.el in
;; order to do the compilation of all the rest of the files.
(defvar lisp-files-needing-early-byte-compilation
- '(;"easy-mmode"
+ '("easy-mmode"
"autoload"
"shadow"
"cl-macs"))
＠＠ -312,10 +312,10 ＠＠
need-to-rebuild-mule-autoloads)
(list "-l" "autoload"))
(if need-to-rebuild-autoloads
- (list "-f" "autoload-update-directory-autoloads"
+ (list "-f" "batch-update-directory-autoloads"
"auto" source-lisp))
(if need-to-rebuild-mule-autoloads
- (list "-f" "autoload-update-directory-autoloads"
+ (list "-f" "batch-update-directory-autoloads"
"mule" source-lisp-mule))
(if need-to-recompile-autoloads
(list "-f" "batch-byte-compile-one-file"
1.12 +12 -19 XEmacs/xemacs/lisp/update-elc-2.el
(In the diff below, changes in quantity of whitespace are not shown.)
Index: update-elc-2.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/update-elc-2.el,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- update-elc-2.el 2003/03/01 07:25:27 1.11
+++ update-elc-2.el 2005/02/03 07:11:20 1.12
＠＠ -149,32 +149,25 ＠＠
;; way is slow, so we avoid it when possible.
(when (file-exists-p (expand-file-name "REBUILD_AUTOLOADS"
invocation-directory))
- (let ((generated-autoload-file (expand-file-name "auto-autoloads.el"
dir))
- (autoload-package-name "auto")) ; feature prefix
;; if we were instructed to rebuild the autoloads, force the file
;; to be touched even w/o changes; otherwise, we won't ever stop
;; being told to rebuild them.
- (update-autoload-files (list dir) nil t)
- (byte-recompile-file generated-autoload-file 0))
+ (update-autoload-files dir "auto" nil t)
+ (byte-recompile-file (expand-file-name "auto-autoloads.el" dir) 0)
(when (featurep 'mule)
- (let* ((muledir (expand-file-name "../lisp/mule" (file-truename dir)))
- (generated-autoload-file
- (expand-file-name "auto-autoloads.el" muledir))
- (autoload-package-name "mule")) ; feature prefix
+ (let ((muledir (expand-file-name "../lisp/mule" (file-truename dir))))
;; force here just like above.
- (update-autoload-files (list muledir) nil t)
- (byte-recompile-file generated-autoload-file 0))))
+ (update-autoload-files muledir "mule" nil t)
+ (byte-recompile-file (expand-file-name "auto-autoloads.el" dir) 0))))
(when (featurep 'modules)
(let* ((moddir (expand-file-name "../modules" (file-truename dir)))
- (generated-autoload-file
- (expand-file-name "auto-autoloads.el" moddir))
- (autoload-package-name "modules")) ; feature prefix
+ (autofile (expand-file-name "auto-autoloads.el" moddir)))
(update-autoload-files
(delete (concat (file-name-as-directory moddir) ".")
(delete (concat (file-name-as-directory moddir) "..")
(directory-files moddir t nil nil 0)))
- t)
- (byte-recompile-file generated-autoload-file 0)))
+ "modules" autofile)
+ (byte-recompile-file autofile 0)))
;; now load the (perhaps newly rebuilt) autoloads; we were called with
;; -no-autoloads so they're not already loaded.
(load (expand-file-name "auto-autoloads" lisp-directory))
1.1 XEmacs/xemacs/lisp/easy-mmode.el
Index: easy-mmode.el
===================================================================
;;; easy-mmode.el --- easy definition for major and minor modes
;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan(a)inria.fr>
;; Maintainer: Stefan Monnier <monnier(a)gnu.org>
;; Keywords: extensions lisp
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Synched up with: GNU Emacs 21.3.
;;; Commentary:
;; Minor modes are useful and common. This package makes defining a
;; minor mode easy, by focusing on the writing of the minor mode
;; functionalities themselves. Moreover, this package enforces a
;; conventional naming of user interface primitives, making things
;; natural for the minor-mode end-users.
;; For each mode, easy-mmode defines the following:
;; <mode> : The minor mode predicate. A buffer-local variable.
;; <mode>-map : The keymap possibly associated to <mode>.
;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode:
;; see `define-minor-mode' documentation
;;
;; eval
;; (pp (macroexpand '(define-minor-mode <your-mode> <doc>)))
;; to check the result before using it.
;; The order in which minor modes are installed is important. Keymap
;; lookup proceeds down minor-mode-map-alist, and the order there
;; tends to be the reverse of the order in which the modes were
;; installed. Perhaps there should be a feature to let you specify
;; orderings.
;; Additionally to `define-minor-mode', the package provides convenient
;; ways to define keymaps, and other helper functions for major and minor
;; modes.
;;; Code:
(eval-when-compile (require 'cl))
;;; This file uses two functions that did not exist in some versions of
;;; XEmacs: propertize and replace-regexp-in-string. We provide these
;;; functions here for such XEmacsen.
;;;
;;; FIXME: These function definitions should go into the future or
;;; forward-compat package, once that package exists.
;; XEmacs <= 21.4 does not have propertize, but XEmacs >= 21.5 dumps it (it is
;; defined in subr.el). Therefore, it is either defined regardless of what
;; has been loaded already, or it won't be defined regardless of what is
;; loaded.
(if (not (fboundp 'propertize))
(defun propertize (string &rest properties)
"Return a copy of STRING with text properties added.
First argument is the string to copy.
Remaining arguments form a sequence of PROPERTY VALUE pairs for text
properties to add to the result."
(let ((str (copy-sequence string)))
(add-text-properties 0 (length str)
properties
str)
str)))
;; XEmacs <= 21.4 does not have replace-regexp-in-string, but XEmacs >= 21.5
;; dumps it (it is defined in subr.el). Therefore, it is either defined
;; regardless of what has been loaded already, or it won't be defined
;; regardless of what is loaded.
(if (not (fboundp 'replace-regexp-in-string))
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
Return a new string containing the replacements.
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'. If START
is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function it is applied to each match to generate
the replacement passed to `replace-match'; the match-data at this
point are such that match 0 is the function's argument.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \"
foo foo\" nil nil 1)
=> \" bar foo\"
"
(let ((l (length string))
(start (or start 0))
matches str mb me)
(save-match-data
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
;; If we matched the empty string, make sure we advance by one char
(when (= me mb) (setq me (min l (1+ mb))))
;; Generate a replacement for the matched substring.
;; Operate only on the substring to minimize string consing.
;; Set up match data for the substring for replacement;
;; presumably this is likely to be faster than munging the
;; match data directly in Lisp.
(string-match regexp (setq str (substring string mb me)))
(setq matches
(cons (replace-match (if (stringp rep)
rep
(funcall rep (match-string 0 str)))
fixedcase literal str subexp)
(cons (substring string start mb) ; unmatched prefix
matches)))
(setq start me))
;; Reconstruct a string from the pieces.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches))))))
(defun easy-mmode-pretty-mode-name (mode &optional lighter)
"Turn the symbol MODE into a string intended for the user.
If provided LIGHTER will be used to help choose capitalization."
(let* ((case-fold-search t)
(name (concat (replace-regexp-in-string
"-Minor" " minor"
(capitalize (replace-regexp-in-string
"-mode\\'" "" (symbol-name mode))))
" mode")))
(if (not (stringp lighter)) name
(setq lighter
(replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" ""
lighter))
(replace-regexp-in-string lighter lighter name t t))))
;; XEmacs change: add -on-hook, -off-hook, and macro parameter documentation.
;;;###no-autoload
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
;;;###no-autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest
body)
"Define a new minor mode MODE.
This function defines the associated control variable MODE, keymap MODE-map,
toggle command MODE, and hook MODE-hook.
DOC is the documentation for the mode toggle command.
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the modeline when the mode is on.
Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
If it is a list, it is passed to `easy-mmode-define-keymap'
in order to build a valid keymap. It's generally better to use
a separate MODE-map variable than to use this argument.
The above three arguments can be skipped if keyword arguments are
used (see below).
BODY contains code that will be executed each time the mode is (de)activated.
It will be executed after any toggling but before running the hooks.
Before the actual body code, you can write
keyword arguments (alternating keywords and values).
These following keyword arguments are supported:
:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
:init-value VAL Same as the INIT-VALUE argument.
:lighter SPEC Same as the LIGHTER argument.
:require SYM Same as in `defcustom'.
For backwards compatibility, these hooks are run each time the mode is
\(de)activated. When the mode is toggled, MODE-hook is always run before the
other hook.
MODE-hook: run if the mode is toggled.
MODE-on-hook: run if the mode is activated.
MODE-off-hook: run if the mode is deactivated.
\(defmacro easy-mmode-define-minor-mode
(MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)...\)
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
nil \"Foo \" foo-keymap
:require 'foo :global t :group 'inconvenience
...BODY CODE...)"
;; Allow skipping the first three args.
(cond
((keywordp init-value)
(setq body (list* init-value lighter keymap body)
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body (list* lighter keymap body) lighter nil keymap nil))
((keywordp keymap) (push keymap body) (setq keymap nil)))
(let* ((mode-name (symbol-name mode))
(pretty-name (easy-mmode-pretty-mode-name mode lighter))
(globalp nil)
(group nil)
(extra-args nil)
(require t)
(keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook"))))
;; Check keys.
(while (keywordp (car body))
(case (pop body)
(:init-value (setq init-value (pop body)))
(:lighter (setq lighter (pop body)))
(:global (setq globalp (pop body)))
(:extra-args (setq extra-args (pop body)))
(:group (setq group (nconc group (list :group (pop body)))))
(:require (setq require (pop body)))
(t (pop body))))
(unless group
;; We might as well provide a best-guess default group.
(setq group
`(:group ',(or (custom-current-group)
(intern (replace-regexp-in-string
"-mode\\'" "" mode-name))))))
;; Add default properties to LIGHTER.
;; #### FSF comments this out in 21.3.
; (unless (or (not (stringp lighter))
; (get-text-property 0 'local-map lighter)
; (get-text-property 0 'keymap lighter))
; (setq lighter
; (propertize lighter
; 'local-map modeline-minor-mode-map ; XEmacs change
; 'help-echo "mouse-3: minor mode menu")))
`(progn
;; Define the variable to enable or disable the mode.
,(if (not globalp)
`(progn
(defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
Use the command `%s' to change this variable." pretty-name mode))
(make-variable-buffer-local ',mode))
(let ((curfile (or (and (boundp 'byte-compile-current-file)
byte-compile-current-file)
load-file-name)))
`(defcustom ,mode ,init-value
,(format "Non-nil if %s is enabled.
See the command `%s' for a description of this minor-mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `%s'."
pretty-name mode mode)
:set (lambda (symbol value) (funcall symbol (or value 0)))
:initialize 'custom-initialize-default
,＠group
:type 'boolean
,＠(cond
((not (and curfile require)) nil)
((not (eq require t)) `(:require ,require))
(t `(:require
',(intern (file-name-nondirectory
(file-name-sans-extension curfile)))))))))
;; The actual function.
(defun ,mode (&optional arg ,＠extra-args)
,(or doc
(format (concat "Toggle %s on or off.
Interactively, with no prefix argument, toggle the mode.
With universal prefix ARG turn mode on.
With zero or negative ARG turn mode off.
\\{%s}") pretty-name keymap-sym))
;; Use `toggle' rather than (if ,mode 0 1) so that using
;; repeat-command still does the toggling correctly.
(interactive (list (or current-prefix-arg 'toggle)))
;; XEmacs addition: save the old mode
(let ((old-mode ,mode))
(setq ,mode
(cond
((eq arg 'toggle) (not ,mode))
(arg (or (listp arg);; XEmacs addition: C-u alone
(> (prefix-numeric-value arg) 0)))
(t
(if (null ,mode) t
(message
"Toggling %s off; better pass an explicit argument."
',mode)
nil))))
,＠body
;; The on/off hooks are here for backward compatibility only.
;; The on/off hooks are here for backward compatibility only.
;; XEmacs change: check mode before running hooks
(and ,hook
(not (equal old-mode ,mode))
(run-hooks ',hook))
(and ,hook-on
,mode
(run-hooks ',hook-on))
(and ,hook-off
(not ,mode)
(run-hooks ',hook-off)))
(if (interactive-p)
(progn
,(if globalp `(customize-mark-as-set ',mode))
(message ,(format "%s %%sabled" pretty-name)
(if ,mode "en" "dis"))))
(force-mode-line-update)
;; Return the new setting.
,mode)
;; Autoloading an easy-mmode-define-minor-mode autoloads
;; everything up-to-here.
;;
;; XEmacs change: XEmacs does not support :autoload-end. On the other
;; hand, I don't see why we need to support it. An autoload cookie
;; just before a (define-minor-mode foo) form will generate an autoload
;; form for the file with name foo. But that's exactly right, since
;; the defun created just above here has the name foo. There are no
;; other top-level forms created above here by the macro, so we're done.
;;
;;:autoload-end
;; The toggle's hook.
(defcustom ,hook nil
,(format "Hook run at the end of function `%s'." mode-name)
,＠group
:type 'hook)
;; XEmacs addition: declare the on and off hooks also
(defcustom ,hook-on nil
,(format "Hook to run when entering %s." mode-name)
:group ,(cadr group)
:type 'hook)
(defcustom ,hook-off nil
,(format "Hook to run when exiting %s." mode-name)
:group ,(cadr group)
:type 'hook)
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
`(defvar ,keymap-sym
(let ((m ,keymap))
(cond ((keymapp m) m)
((listp m) (easy-mmode-define-keymap m))
(t (error "Invalid keymap %S" ,keymap))))
,(format "Keymap for `%s'." mode-name)))
(add-minor-mode ',mode ',lighter
,(if keymap keymap-sym
`(if (boundp ',keymap-sym)
(symbol-value ',keymap-sym)))
;; XEmacs change: supply the AFTER and TOGGLE-FUN args
t ',mode)
;; If the mode is global, call the function according to the default.
,(if globalp
`(if (and load-file-name (not (equal ,init-value ,mode))
;; XEmacs addition:
(not purify-flag))
(eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
;;;
;;; make global minor mode
;;;
;;;###no-autoload
(defmacro easy-mmode-define-global-mode (global-mode mode turn-on
&rest keys)
"Make GLOBAL-MODE out of the buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
KEYS is a list of CL-style keyword arguments:
:group to specify the custom group."
(let* ((global-mode-name (symbol-name global-mode))
(pretty-name (easy-mmode-pretty-mode-name mode))
(pretty-global-name (easy-mmode-pretty-mode-name global-mode))
(group nil)
(extra-args nil)
(buffers (intern (concat global-mode-name "-buffers")))
(cmmh (intern (concat global-mode-name "-cmmh"))))
;; Check keys.
(while (keywordp (car keys))
(case (pop keys)
(:extra-args (setq extra-args (pop keys)))
(:group (setq group (nconc group (list :group (pop keys)))))
(t (setq keys (cdr keys)))))
(unless group
;; We might as well provide a best-guess default group.
(setq group
`(:group ',(or (custom-current-group)
(intern (replace-regexp-in-string
"-mode\\'" "" (symbol-name mode)))))))
`(progn
;; The actual global minor-mode
(define-minor-mode ,global-mode
,(format "Toggle %s in every buffer.
With prefix ARG, turn %s on if and only if ARG is positive.
%s is actually not turned on in every buffer but only in those
in which `%s' turns it on."
pretty-name pretty-global-name pretty-name turn-on)
:global t :extra-args ,extra-args ,＠group
;; Setup hook to handle future mode changes and new buffers.
(if ,global-mode
;; XEmacs: find-file-hooks not find-file-hook
(progn
(add-hook 'find-file-hooks ',buffers)
(add-hook 'change-major-mode-hook ',cmmh))
(remove-hook 'find-file-hooks ',buffers)
(remove-hook 'change-major-mode-hook ',cmmh))
;; Go through existing buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
(if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
;; TODO: XEmacs does not support :autoload-end
;; Autoloading easy-mmode-define-global-mode
;; autoloads everything up-to-here.
:autoload-end
;; List of buffers left to process.
(defvar ,buffers nil)
;; The function that calls TURN-ON in each buffer.
(defun ,buffers ()
(remove-hook 'post-command-hook ',buffers)
(while ,buffers
(let ((buf (pop ,buffers)))
(when (buffer-live-p buf)
(with-current-buffer buf (,turn-on))))))
(put ',buffers 'definition-name ',global-mode)
;; The function that catches kill-all-local-variables.
(defun ,cmmh ()
(add-to-list ',buffers (current-buffer))
(add-hook 'post-command-hook ',buffers))
(put ',cmmh 'definition-name ',global-mode))))
;;;
;;; easy-mmode-defmap
;;;
(if (fboundp 'set-keymap-parents)
(defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
(defun easy-mmode-set-keymap-parents (m parents)
(set-keymap-parent
m
(cond
((not (consp parents)) parents)
((not (cdr parents)) (car parents))
(t (let ((m (copy-keymap (pop parents))))
(easy-mmode-set-keymap-parents m parents)
m))))))
;;;###no-autoload
(defun easy-mmode-define-keymap (bs &optional name m args)
"Return a keymap built from bindings BS.
BS must be a list of (KEY . BINDING) where
KEY and BINDINGS are suitable for `define-key'.
Optional NAME is passed to `make-sparse-keymap'.
Optional map M can be used to modify an existing map.
ARGS is a list of additional keyword arguments."
(let (inherit dense ;suppress
)
(while args
(let ((key (pop args))
(val (pop args)))
(case key
(:name (setq name val))
(:dense (setq dense val))
(:inherit (setq inherit val))
(:group)
;;((eq key :suppress) (setq suppress val))
(t (message "Unknown argument %s in defmap" key)))))
(unless (keymapp m)
(setq bs (append m bs))
(setq m (if dense (make-keymap name) (make-sparse-keymap name))))
(dolist (b bs)
(let ((keys (car b))
(binding (cdr b)))
(dolist (key (if (consp keys) keys (list keys)))
(cond
((symbolp key)
(substitute-key-definition key binding m global-map))
((null binding)
(unless (keymapp (lookup-key m key)) (define-key m key binding)))
((let ((o (lookup-key m key)))
(or (null o) (numberp o) (eq o 'undefined)))
(define-key m key binding))))))
(cond
((keymapp inherit) (set-keymap-parent m inherit))
((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
m))
;;;###no-autoload
(defmacro easy-mmode-defmap (m bs doc &rest args)
`(defconst ,m
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
,doc))
;;;
;;; easy-mmode-defsyntax
;;;
(defun easy-mmode-define-syntax (css args)
(let ((st (make-syntax-table (plist-get args :copy)))
(parent (plist-get args :inherit)))
(dolist (cs css)
(let ((char (car cs))
(syntax (cdr cs)))
(if (sequencep char)
(mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
(modify-syntax-entry char syntax st))))
;; XEmacs change: we do not have set-char-table-parent
(if parent (derived-mode-merge-syntax-tables
(if (symbolp parent) (symbol-value parent) parent) st))
st))
;;;###no-autoload
(defmacro easy-mmode-defsyntax (st css doc &rest args)
"Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
`(progn
(autoload 'easy-mmode-define-syntax "easy-mmode")
(defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
;;;
;;; easy-mmode-define-navigation
;;;
;; XEmacs change: autoload
;;;###no-autoload
(defmacro easy-mmode-define-navigation (base re &optional name endfun)
"Define BASE-next and BASE-prev to navigate in the buffer.
RE determines the places the commands should move point to.
NAME should describe the entities matched by RE. It is used to build
the docstrings of the two functions.
BASE-next also tries to make sure that the whole entry is visible by
searching for its end (by calling ENDFUN if provided or by looking for
the next entry) and recentering if necessary.
ENDFUN should return the end position (with or without moving point)."
(let* ((base-name (symbol-name base))
(prev-sym (intern (concat base-name "-prev")))
(next-sym (intern (concat base-name "-next"))))
(unless name (setq name (symbol-name base-name)))
`(progn
(add-to-list 'debug-ignored-errors
,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
(defun ,next-sym (&optional count)
,(format "Go to the next COUNT'th %s." name)
(interactive)
(unless count (setq count 1))
(if (< count 0) (,prev-sym (- count))
(if (looking-at ,re) (incf count))
(if (not (re-search-forward ,re nil t count))
(if (looking-at ,re)
(goto-char (or ,(if endfun `(,endfun)) (point-max)))
(error ,(format "No next %s" name)))
(goto-char (match-beginning 0))
(when (and (eq (current-buffer) (window-buffer (selected-window)))
(interactive-p))
(let ((endpt (or (save-excursion
,(if endfun `(,endfun)
`(re-search-forward ,re nil t 2)))
(point-max))))
;; XEmacs change: versions < 21.5.16 have a
;; pos-visible-in-window-p that takes only 2 parameters
(unless
(if (eq (function-max-args #'pos-visible-in-window-p) 2)
(pos-visible-in-window-p endpt nil)
(pos-visible-in-window-p endpt nil t))
(recenter '(0))))))))
(defun ,prev-sym (&optional count)
,(format "Go to the previous COUNT'th %s" (or name base-name))
(interactive)
(unless count (setq count 1))
(if (< count 0) (,next-sym (- count))
(unless (re-search-backward ,re nil t count)
(error ,(format "No previous %s" name))))))))
(provide 'easy-mmode)
;;; easy-mmode.el ends here
1.1 XEmacs/xemacs/lisp/regexp-opt.el
Index: regexp-opt.el
===================================================================
;;; regexp-opt.el --- generate efficient regexps to match strings
;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon(a)gnu.org>
;; Maintainer: FSF
;; Keywords: strings, regexps, extensions
;; Modified by Karl M. Hegbloom Sep. 1997 to support the new regexp syntax
;; with shy groups. (benchmarks pending)
;; This file is part of XEmacs.
;; XEmacs 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.
;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; The "opt" in "regexp-opt" stands for
"optim\\(al\\|i\\(se\\|ze\\)\\)".
;;
;; This package generates a regexp from a given list of strings (which matches
;; one of those strings) so that the regexp generated by:
;;
;; (regexp-opt strings)
;;
;; is equivalent to, but more efficient than, the regexp generated by:
;;
;; (mapconcat 'regexp-quote strings "\\|")
;;
;; For example:
;;
;; (let ((strings '("cond" "if" "when"
"unless" "while"
;; "let" "let*" "progn" "prog1"
"prog2"
;; "save-restriction" "save-excursion"
"save-window-excursion"
;; "save-current-buffer" "save-match-data"
;; "catch" "throw" "unwind-protect"
"condition-case")))
;; (concat "(" (regexp-opt strings t) "\\>"))
;;
;; =>
"(\\(?:c\\(?:atch\\|ond\\(?:ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(?:current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(?:less\\|wind-protect\\)\\|wh\\(?:en\\|ile\\)\\)\\>"
;;
;;
;; (let ((strings '("cond" "if" "when"
"unless" "while"
;; "let" "let*" "progn" "prog1"
"prog2"
;; "save-restriction" "save-excursion"
"save-window-excursion"
;; "save-current-buffer" "save-match-data"
;; "catch" "throw" "unwind-protect"
"condition-case")))
;; (concat "(" (regexp-opt strings t t) "\\>"))
;; ^
;; =>
"(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>"
;;
;;
;; Searching using the above example `regexp-opt' regexp takes approximately
;; two-thirds of the time taken using the equivalent `mapconcat' regexp.
;; Since this package was written to produce efficient regexps, not regexps
;; efficiently, it is probably not a good idea to in-line too many calls in
;; your code, unless you use the following trick with `eval-when-compile':
;;
;; (defvar definition-regexp
;; (eval-when-compile
;; (concat "^("
;; (regexp-opt '("defun" "defsubst"
"defmacro" "defalias"
;; "defvar" "defconst") t)
;; "\\>")))
;;
;; The `byte-compile' code will be as if you had defined the variable thus:
;;
;; (defvar definition-regexp
;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
;;
;; Note that if you use this trick for all instances of `regexp-opt' and
;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded
;; at compile time. But note also that using this trick means that should
;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to
;; improve the efficiency of `regexp-opt' regexps, you would have to recompile
;; your code for such changes to have effect in your code.
;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu.
;; Please don't tell me that it doesn't produce optimal regexps; I know that
;; already. For example, the above explanation for the meaning of "opt"
would
;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex
;; forward looking. But (ideas or) code to improve things (are) is welcome.
;;; Code:
;;;###autoload
(defun regexp-opt (strings &optional paren non-shy)
"Return a regexp to match a string in STRINGS.
Each string should be unique in STRINGS and should not contain any regexps,
quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
is enclosed by at least one regexp match grouping construct. If optional
NON-SHY is non nil, the inner groupings will use \"\\\\( \\\\)\" grouping,
rather than the default \"\\\\(?: \\\\)\" 'shy', or
non-match-capturing groups.
The returned regexp is typically more efficient than the equivalent regexp:
(let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN
\"\\\\)\" \"\")))
(concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\")
close-paren))
but typically contains more regexp grouping constructs.
Use `regexp-opt-depth' to count them.
If PAREN is `words', then the resulting regexp is additionally surrounded
by \\=\\< and \\>."
(save-match-data
;; Recurse on the sorted list.
(let* ((max-lisp-eval-depth (* 1024 1024))
(completion-ignore-case nil)
(words (eq paren 'words))
(sorted-strings (sort (copy-sequence strings) 'string-lessp))
(re (regexp-opt-group sorted-strings paren nil non-shy)))
(if words (concat "\\<" re "\\>") re))))
;;;###autoload
(defun regexp-opt-depth (regexp &optional count-shy-groups-too)
"Return the depth of REGEXP.
This means the number of regexp grouping constructs (parenthesised
expressions) in REGEXP, not counting the \"\\\\(?: \\\\)\"
non-match-capturing groups unless COUNT-SHY-GROUPS-TOO is non-nil.
See `regexp-opt'."
(save-match-data
;; Hack to signal an error if REGEXP does not have balanced parentheses.
(string-match regexp "")
;; Count the number of open parentheses in REGEXP.
(let ((max (1- (length regexp)))
(count 0) start)
(while (string-match "\\\\(" regexp start)
(setq start (match-end 0))
(when (or count-shy-groups-too
(not (string= (substring regexp start (min (+ start 2) max))
"?:")))
(setq count (1+ count))))
count)))
;;; Workhorse functions.
(eval-when-compile
(require 'cl))
(unless (fboundp 'make-bool-vector)
(defalias 'make-bool-vector 'make-vector))
(defun regexp-opt-group (strings &optional paren lax non-shy)
"Return a regexp to match a string in STRINGS.
If PAREN non-nil, output regexp parentheses around returned regexp.
If LAX non-nil, don't output parentheses if it doesn't require them.
If NON-SHY non-nil, don't use \\(?: \\) shy groups, use match capturing ones.
Merges keywords to avoid backtracking in Emacs' regexp matcher.
The basic idea is to find the shortest common prefix, remove it
and recurse. If there is no prefix, we divide the list into two so that
\(at least) one half will have at least a one-character common prefix.
Also we delay the addition of grouping parenthesis as long as possible
until we're sure we need them, and try to remove one-character sequences
so we can use character sets rather than grouping parenthesis."
(let* ((open-group (cond
((and paren non-shy) "\\(")
(paren "\\(?:")
(t "")))
(close-group (if paren "\\)" ""))
(open-charset (if lax "" open-group))
(close-charset (if lax "" close-group)))
(cond
;;
;; If there are no strings, just return the empty string.
((= (length strings) 0)
"")
;;
;; If there is only one string, just return it.
((= (length strings) 1)
(if (= (length (car strings)) 1)
(concat open-charset (regexp-quote (car strings)) close-charset)
(concat open-group (regexp-quote (car strings)) close-group)))
;;
;; If there is an empty string, remove it and recurse on the rest.
((= (length (car strings)) 0)
(concat open-charset
(regexp-opt-group (cdr strings) t t non-shy) "?"
close-charset))
;;
;; If all are one-character strings, just return a character set.
((= (length strings) (apply '+ (mapcar 'length strings)))
(concat open-charset
(regexp-opt-charset strings)
close-charset))
;;
;; We have a list of different length strings.
(t
(let ((prefix (try-completion "" (mapcar 'list strings)))
(letters (let ((completion-regexp-list '("^.$")))
(all-completions "" (mapcar 'list strings)))))
(cond
;;
;; If there is a common prefix, remove it and recurse on the suffixes.
((> (length prefix) 0)
(let* ((length (length prefix))
(suffixes (mapcar (lambda (s) (substring s length)) strings)))
(concat open-group
(regexp-quote prefix) (regexp-opt-group suffixes t t non-shy)
close-group)))
;;
;; If there are several one-character strings, remove them and recurse
;; on the rest (first so the final regexp finds the longest match).
((> (length letters) 1)
(let ((rest (let ((completion-regexp-list '("^..+$")))
(all-completions "" (mapcar 'list strings)))))
(concat open-group
(regexp-opt-group rest nil nil non-shy) "\\|" (regexp-opt-charset
letters)
close-group)))
;;
;; Otherwise, divide the list into those that start with a particular
;; letter and those that do not, and recurse on them.
(t
(let* ((char (substring (car strings) 0 1))
(half1 (all-completions char (mapcar 'list strings)))
(half2 (nthcdr (length half1) strings)))
(concat open-group
(regexp-opt-group half1 nil nil non-shy) "\\|" (regexp-opt-group half2
nil nil non-shy)
close-group)))))))))
(defun regexp-opt-charset (chars)
;;
;; Return a regexp to match a character in CHARS.
;;
;; The basic idea is to find character ranges. Also we take care in the
;; position of character set meta characters in the character set regexp.
;;
(let* ((charwidth 256) ; Yeah, right.
;; XEmacs: use bit-vectors instead of bool-vectors
(charmap (make-bit-vector charwidth 0))
(charset "")
(bracket "") (dash "") (caret ""))
;;
;; Make a character map but extract character set meta characters.
(dolist (char (mapcar 'string-to-char chars))
(case char
(?\]
(setq bracket "]"))
(?^
(setq caret "^"))
(?-
(setq dash "-"))
(otherwise
;; XEmacs: 1
(aset charmap char 1))))
;;
;; Make a character set from the map using ranges where applicable.
(dotimes (char charwidth)
(let ((start char))
(while (and (< char charwidth)
;; XEmacs: (not (zerop ...))
(not (zerop (aref charmap char))))
(incf char))
(cond ((> char (+ start 3))
(setq charset (format "%s%c-%c" charset start (1- char))))
((> char start)
(setq charset (format "%s%c" charset (setq char start)))))))
;;
;; Make sure a caret is not first and a dash is first or last.
(if (and (string-equal charset "") (string-equal bracket ""))
(concat "[" dash caret "]")
(concat "[" bracket charset caret dash "]"))))
(provide 'regexp-opt)
;;; regexp-opt.el ends here
1.784 +13 -29 XEmacs/xemacs/src/ChangeLog
(In the diff below, changes in quantity of whitespace are not shown.)
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.783
retrieving revision 1.784
diff -u -b -r1.783 -r1.784
--- ChangeLog 2005/02/03 05:03:43 1.783
+++ ChangeLog 2005/02/03 07:11:26 1.784
＠＠ -1,18 +1,5 ＠＠
2005-02-02 Ben Wing <ben(a)xemacs.org>
- * menubar.c:
- * menubar.c (Fcompare_menu_text):
- New fun to compare menu itext as if the two were normalized.
-
- * menubar.c (Fnormalize_menu_text):
- * menubar.c (syms_of_menubar):
- Rename; there are no external callers of this function.
- Remove unneeded BUFFER argument. Don't downcase.
- (This will be done in compare-menu-text.)
- Document that return value may be same string.
-
-2005-02-02 Ben Wing <ben(a)xemacs.org>
-
* lread.c:
* lread.c (check_if_suppressed):
* lread.c (Fload_internal):
＠＠ -20,28 +7,25 ＠＠
* lread.c (readevalloop):
* lread.c (syms_of_lread):
* lread.c (vars_of_lread):
- * menubar.c:
- * menubar.c (Fcompare_menu_text):
- * menubar.c (Fnormalize_menu_text):
- * menubar.c (syms_of_menubar):
- * menubar.c (vars_of_menubar):
-
-2004-11-09 Ben Wing <ben(a)xemacs.org>
-
* lisp.h:
-
- * lread.c:
- * lread.c (check_if_suppressed):
- * lread.c (Fload_internal):
- * lread.c (locate_file_in_directory_mapper):
- * lread.c (readevalloop):
- * lread.c (syms_of_lread):
- * lread.c (vars_of_lread):
Remove undeeded Vload_file_name_internal_the_purecopy,
Qload_file_name -- use internal_bind_lisp_object instead of
specbind.
Add load-suppress-alist.
+
+2005-02-02 Ben Wing <ben(a)xemacs.org>
+
+ * menubar.c:
+ * menubar.c (Fcompare_menu_text):
+ New fun to compare menu itext as if the two were normalized.
+
+ * menubar.c (Fnormalize_menu_text):
+ * menubar.c (syms_of_menubar):
+ Rename; there are no external callers of this function.
+ Remove unneeded BUFFER argument. Don't downcase.
+ (This will be done in compare-menu-text.)
+ Document that return value may be same string.
2003-02-15 Ben Wing <ben(a)xemacs.org>
1.74 +69 -17 XEmacs/xemacs/src/lread.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: lread.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lread.c,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -b -r1.73 -r1.74
--- lread.c 2005/01/24 23:34:02 1.73
+++ lread.c 2005/02/03 07:11:27 1.74
＠＠ -59,8 +59,8 ＠＠
#endif
Lisp_Object Qvariable_domain; /* I18N3 */
Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
-Lisp_Object Qcurrent_load_list;
-Lisp_Object Qload, Qload_file_name, Qload_internal, Qfset;
+Lisp_Object Vload_suppress_alist;
+Lisp_Object Qload, Qload_internal, Qfset;
/* Hash-table that maps directory names to hashes of their contents. */
static Lisp_Object Vlocate_file_hash_table;
＠＠ -118,8 +118,6 ＠＠
our #$ checks are reliable. */
Lisp_Object Vload_file_name_internal;
-Lisp_Object Vload_file_name_internal_the_purecopy;
-
/* Function to use for reading, in `load' and friends. */
Lisp_Object Vload_read_function;
＠＠ -340,6 +338,50 ＠＠
return Qnil;
}
+/* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
+ to load-suppress-alist. */
+static int
+check_if_suppressed (Ibyte *nonreloc, Lisp_Object reloc)
+{
+ Bytecount len;
+
+ if (!NILP (reloc))
+ {
+ nonreloc = XSTRING_DATA (reloc);
+ len = XSTRING_LENGTH (reloc);
+ }
+ else
+ len = qxestrlen (nonreloc);
+
+ if (len >= 4 && !qxestrcmp_ascii (nonreloc + len - 4, ".elc"))
+ len -= 4;
+ else if (len >= 3 && !qxestrcmp_ascii (nonreloc + len - 3,
".el"))
+ len -= 3;
+
+ EXTERNAL_LIST_LOOP_2 (acons, Vload_suppress_alist)
+ {
+ if (CONSP (acons) && STRINGP (XCAR (acons)))
+ {
+ Lisp_Object name = XCAR (acons);
+ if (XSTRING_LENGTH (name) == len &&
+ !memcmp (XSTRING_DATA (name), nonreloc, len))
+ {
+ struct gcpro gcpro1;
+ Lisp_Object val;
+
+ GCPRO1 (reloc);
+ val = Feval (XCDR (acons));
+ UNGCPRO;
+
+ if (!NILP (val))
+ return 1;
+ }
+ }
+ }
+
+ return 0;
+}
+
/* The plague is coming.
Ring around the rosy, pocket full of posy,
＠＠ -689,12 +731,11 ＠＠
internal_bind_lisp_object (&Vload_descriptor_list,
Fcons (make_int (fd), Vload_descriptor_list));
internal_bind_lisp_object (&Vload_file_name_internal, found);
- internal_bind_lisp_object (&Vload_file_name_internal_the_purecopy, Qnil);
/* this is not a simple internal_bind. */
record_unwind_protect (load_force_doc_string_unwind,
Vload_force_doc_string_list);
Vload_force_doc_string_list = Qnil;
- specbind (Qload_file_name, found);
+ internal_bind_lisp_object (&Vload_file_name, found);
#ifdef I18N3
/* set it to nil; a call to #'domain will set it. */
internal_bind_lisp_object (&Vfile_domain, Qnil);
＠＠ -818,6 +859,9 ＠＠
requirements. Allowed symbols are `exists', `executable', `writable', and
`readable'. If MODE is nil, it defaults to `readable'.
+Filenames are checked against `load-suppress-alist' to determine if they
+should be ignored.
+
`locate-file' keeps hash tables of the directories it searches through,
in order to speed things up. It tries valiantly to not get confused in
the face of a changing and unpredictable environment, but can occasionally
＠＠ -1024,6 +1068,8 ＠＠
if (closure->fd >= 0)
{
+ if (!check_if_suppressed (fn, Qnil))
+ {
/* We succeeded; return this descriptor and filename. */
if (closure->storeptr)
*closure->storeptr = build_intstring (fn);
＠＠ -1031,6 +1077,7 ＠＠
return 1;
}
}
+ }
/* Keep mapping. */
return 0;
}
＠＠ -1178,7 +1225,7 ＠＠
just look for one for which access(file,MODE) succeeds. In this case,
returns a nonnegative value on success. On failure, returns -1.
- If STOREPTR is nonzero, it points to a slot where the name of
+ If STOREPTR is non-nil, it points to a slot where the name of
the file actually found should be stored as a Lisp string.
Nil is stored there on failure.
＠＠ -1377,7 +1424,7 ＠＠
READCHARFUN (which can be a stream) to Lisp. --hniksic */
/*specbind (Qstandard_input, readcharfun);*/
- specbind (Qcurrent_load_list, Qnil);
+ internal_bind_lisp_object (&Vcurrent_load_list, Qnil);
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
＠＠ -3072,9 +3119,7 ＠＠
DEFSYMBOL (Qstandard_input);
DEFSYMBOL (Qread_char);
- DEFSYMBOL (Qcurrent_load_list);
DEFSYMBOL (Qload);
- DEFSYMBOL (Qload_file_name);
DEFSYMBOL (Qload_internal);
DEFSYMBOL (Qfset);
＠＠ -3141,6 +3186,16 ＠＠
Non-nil iff inside of `load'.
*/ );
+ DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
+An alist of expressions controlling whether particular files can be loaded.
+Each element looks like (FILENAME EXPR).
+FILENAME should be a full pathname, but without the .el suffix.
+When `load' is run and is about to load the specified file, it evaluates
+the form to determine if the file can be loaded.
+This variable is normally initialized automatically.
+*/ );
+ Vload_suppress_alist = Qnil;
+
DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
An alist of expressions to be evalled when particular files are loaded.
Each element looks like (FILENAME FORMS...).
＠＠ -3254,9 +3309,6 ＠＠
Vload_file_name_internal = Qnil;
staticpro (&Vload_file_name_internal);
-
- Vload_file_name_internal_the_purecopy = Qnil;
- staticpro (&Vload_file_name_internal_the_purecopy);
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
1.123 +1 -2 XEmacs/xemacs/src/lisp.h
(In the diff below, changes in quantity of whitespace are not shown.)
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.122
retrieving revision 1.123
diff -u -b -r1.122 -r1.123
--- lisp.h 2005/01/31 19:29:49 1.122
+++ lisp.h 2005/02/03 07:11:28 1.123
＠＠ -5294,8 +5294,7 ＠＠
extern Lisp_Object Vinvocation_directory, Vinvocation_name;
extern Lisp_Object Vlast_command, Vlast_command_char;
extern Lisp_Object Vlast_command_event, Vlast_input_event;
-extern Lisp_Object Vload_file_name_internal;
-extern Lisp_Object Vload_file_name_internal_the_purecopy, Vload_history;
+extern Lisp_Object Vload_file_name_internal, Vload_history;
extern Lisp_Object Vload_path, Vmark_even_if_inactive, Vmenubar_configuration;
extern Lisp_Object Vminibuf_preprompt, Vminibuf_prompt, Vminibuffer_zero;
extern Lisp_Object Vmodule_directory, Vmswindows_downcase_file_names;