;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
;;; Copyright (C) 1996 Ben Wing.
-;; Authors: Jamie Zawinski <jwz@jwz.org>
+;; Author: Jamie Zawinski <jwz@netscape.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Ben Wing <ben@xemacs.org>
-;; Martin Buchholz <martin@xemacs.org>
-;; Richard Stallman <rms@gnu.org>
-;; Keywords: internal lisp
+;; Keywords: internal
-(defconst byte-compile-version (purecopy "2.27 XEmacs; 2000-09-12."))
+;; Subsequently modified by RMS and others.
+
+(defconst byte-compile-version (purecopy "2.26 XEmacs; 1998-10-07."))
;; This file is part of XEmacs.
;;; Commentary:
;; The Emacs Lisp byte compiler. This crunches lisp source into a
-;; sort of p-code (`bytecode') which takes up less space and can be
-;; interpreted faster. First, the source code forms are converted to
-;; an intermediate form, `lapcode' [`LAP' == `Lisp Assembly Program']
-;; which is much easier to manipulate than bytecode. Then the lapcode
-;; is converted to bytecode, which can be considered to be actual
-;; machine language. Optimizations can occur at either the source
-;; level or the lapcode level.
-
-;; The user entry points are byte-compile-file,
+;; sort of p-code which takes up less space and can be interpreted
+;; faster. The user entry points are byte-compile-file,
;; byte-recompile-directory and byte-compile-buffer.
;;; Code:
(concat "!! "
(format (if (cdr error-info) "%s (%s)" "%s")
(get (car error-info) 'error-message)
- (prin1-to-string (cdr error-info)))))
- (if stack-trace-on-error
- (backtrace nil t)))
+ (prin1-to-string (cdr error-info))))))
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
(point-max byte-compile-log-buffer))))
(unwind-protect
- (call-with-condition-handler
- #'(lambda (error-info)
- (byte-compile-report-error error-info))
- #'(lambda ()
- (progn ,@body)))
+ (condition-case error-info
+ (progn ,@body)
+ (error
+ (byte-compile-report-error error-info)))
+
;; Always set point in log to start of interesting output.
(with-current-buffer byte-compile-log-buffer
(let ((show-begin
"Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
Files in subdirectories of DIRECTORY are processed also."
(interactive "DByte force recompile (directory): ")
- (byte-recompile-directory directory nil nil t))
+ (byte-recompile-directory directory nil t))
;;;###autoload
(defun byte-recompile-directory (directory &optional arg norecursion force)
(unless byte-compile-overwrite-file
(ignore-file-errors (delete-file target-file)))
(if (file-writable-p target-file)
- (write-region 1 (point-max) target-file)
+ (progn
+ (when (memq system-type '(ms-dos windows-nt))
+ (defvar buffer-file-type)
+ (setq buffer-file-type t))
+ (write-region 1 (point-max) target-file))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
;; 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
+ ;; Otherwise, use `no-conversion' for maximum portability with non-Mule
;; Emacsen.
- (when (featurep '(or mule file-coding))
+ (when (featurep 'mule)
(defvar buffer-file-coding-system)
- (if (or (featurep '(not mule)) ;; Don't scan buffer if we are not muleized
- (save-excursion
- (set-buffer byte-compile-inbuffer)
- (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)
+ (if (save-excursion
+ (set-buffer byte-compile-inbuffer)
+ (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 'no-conversion)
(insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
(setq buffer-file-coding-system 'escape-quoted)
;; #### Lazy loading not yet implemented for MULE files
(while (if (setq form (cdr form))
(byte-compile-constp (car form))))
(null form)))
- ;; eval the macro autoload into the compilation environment
+ ;; eval the macro autoload into the compilation enviroment
(eval form))
(if name
;; No doc string, so we can compile this as a normal form.
(byte-compile-keep-pending form 'byte-compile-normal-call)))
-(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
-(defun byte-compile-file-form-defvar-or-defconst (form)
- ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
+(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
+(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
+(defun byte-compile-file-form-defvar (form)
(if (> (length form) 4)
- (byte-compile-warn
- "%s %s called with %d arguments, but accepts only %s"
- (car form) (nth 1 form) (length (cdr form)) 3))
+ (byte-compile-warn "%s used with too many args (%s)"
+ (car form) (nth 1 form)))
(if (and (> (length form) 3) (not (stringp (nth 3 form))))
(byte-compile-warn "Third arg to %s %s is not a string: %s"
(car form) (nth 1 form) (nth 3 form)))
(byte-defop-compiler-1 defun)
(byte-defop-compiler-1 defmacro)
(byte-defop-compiler-1 defvar)
-(byte-defop-compiler-1 defvar byte-compile-defvar-or-defconst)
-(byte-defop-compiler-1 defconst byte-compile-defvar-or-defconst)
+(byte-defop-compiler-1 defconst byte-compile-defvar)
(byte-defop-compiler-1 autoload)
;; According to Mly this can go now that lambda is a macro
;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
(list 'quote (cons 'macro (eval code))))))
(list 'quote (nth 1 form)))))
-(defun byte-compile-defvar-or-defconst (form)
- ;; This is not used for file-level defvar/defconsts with doc strings:
- ;; byte-compile-file-form-defvar-or-defconst will be used in that case.
- ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
- (let ((fun (nth 0 form))
- (var (nth 1 form))
+(defun byte-compile-defvar (form)
+ ;; This is not used for file-level defvar/consts with doc strings:
+ ;; byte-compile-file-form-defvar will be used in that case.
+ (let ((var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
- (when (> (length form) 4)
- (byte-compile-warn
- "%s %s called with %d arguments, but accepts only %s"
- fun var (length (cdr form)) 3))
- (when (memq 'free-vars byte-compile-warnings)
- (push (cons var byte-compile-global-bit) byte-compile-bound-variables))
+ (if (> (length form) 4)
+ (byte-compile-warn "%s used with too many args" (car form)))
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (cons var byte-compile-global-bit)
+ byte-compile-bound-variables)))
(byte-compile-body-do-effect
- (list
- ;; Put the defined variable in this library's load-history entry
- ;; just as a real defvar would, but only in top-level forms.
- (when (null byte-compile-current-form)
- `(push ',var current-load-list))
- (when (> (length form) 3)
- (when (and string (not (stringp string)))
- (byte-compile-warn "Third arg to %s %s is not a string: %s"
- fun var string))
- `(put ',var 'variable-documentation ,string))
- (if (cdr (cdr form)) ; `value' provided
- (if (eq fun 'defconst)
- ;; `defconst' sets `var' unconditionally.
- `(setq ,var ,value)
- ;; `defvar' sets `var' only when unbound.
- `(if (not (boundp ',var)) (setq ,var ,value))))
- `',var))))
+ (list (if (cdr (cdr form))
+ (if (eq (car form) 'defconst)
+ (list 'setq var value)
+ (list 'or (list 'boundp (list 'quote var))
+ (list 'setq var value))))
+ ;; Put the defined variable in this library's load-history entry
+ ;; just as a real defvar would.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote var)
+ 'current-load-list))
+ (if string
+ (list 'put (list 'quote var) ''variable-documentation string))
+ (list 'quote var)))))
(defun byte-compile-autoload (form)
(and (byte-compile-constp (nth 1 form))
(error "`batch-byte-compile' is to be used only with -batch"))
(let ((error nil))
(while command-line-args-left
- (if (null (batch-byte-compile-one-file))
- (setq error t)))
+ (if (file-directory-p (expand-file-name (car command-line-args-left)))
+ (let ((files (directory-files (car command-line-args-left)))
+ source dest)
+ (while files
+ (if (and (string-match emacs-lisp-file-regexp (car files))
+ (not (auto-save-file-name-p (car files)))
+ (setq source (expand-file-name
+ (car files)
+ (car command-line-args-left)))
+ (setq dest (byte-compile-dest-file source))
+ (file-exists-p dest)
+ (file-newer-than-file-p source dest))
+ (if (null (batch-byte-compile-1 source))
+ (setq error t)))
+ (setq files (cdr files))))
+ (if (null (batch-byte-compile-1 (car command-line-args-left)))
+ (setq error t)))
+ (setq command-line-args-left (cdr command-line-args-left)))
(message "Done")
(kill-emacs (if error 1 0))))
-;;;###autoload
-(defun batch-byte-compile-one-file ()
- "Run `byte-compile-file' on a single file remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs."
- ;; command-line-args-left is what is left of the command line (from
- ;; startup.el)
- (defvar command-line-args-left) ;Avoid 'free variable' warning
- (if (not noninteractive)
- (error "`batch-byte-compile-one-file' is to be used only with -batch"))
- (let (error
- (file-to-process (car command-line-args-left)))
- (setq command-line-args-left (cdr command-line-args-left))
- (if (file-directory-p (expand-file-name file-to-process))
- (let ((files (directory-files file-to-process))
- source dest)
- (while files
- (if (and (string-match emacs-lisp-file-regexp (car files))
- (not (auto-save-file-name-p (car files)))
- (setq source (expand-file-name
- (car files)
- file-to-process))
- (setq dest (byte-compile-dest-file source))
- (file-exists-p dest)
- (file-newer-than-file-p source dest))
- (if (null (batch-byte-compile-1 source))
- (setq error t)))
- (setq files (cdr files)))
- (null error))
- (batch-byte-compile-1 file-to-process))))
-
(defun batch-byte-compile-1 (file)
(condition-case err
(progn (byte-compile-file file) t)
projects / chise / xemacs-chise.git.1 / blobdiff