;;; dgnushack.el --- a hack to set the load path for byte-compiling
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(t (concat filename ".elc"))))
(require 'bytecomp)
+;; To avoid having defsubsts and inlines happen.
+;(if (featurep 'xemacs)
+; (require 'byte-optimize)
+; (require 'byte-opt))
+;(defun byte-optimize-inline-handler (form)
+; "byte-optimize-handler for the `inline' special-form."
+; (cons 'progn (cdr form)))
+;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
(when (boundp 'MULE)
(let (current-load-list)
nil))
(byte-compile 'locate-library)))
-(unless (fboundp 'si:byte-optimize-form-code-walker)
- (byte-optimize-form nil);; Load `byte-opt' or `byte-optimize'.
- (setq max-specpdl-size 3000)
- (defalias 'si:byte-optimize-form-code-walker
- (symbol-function 'byte-optimize-form-code-walker))
- (defun byte-optimize-form-code-walker (form for-effect)
+(setq max-specpdl-size 3000)
+
+(when (equal
+ (cadr
+ (byte-optimize-form
+ '(and
+ (< 0 1)
+ (message "The subform `(< 0 1)' should be optimized to `t'"))
+ 'for-effect))
+ '(< 0 1))
+ (defadvice byte-optimize-form-code-walker
+ (around fix-bug-in-and/or-forms (form for-effect) activate)
+ "Fix a bug in the optimizing and/or forms.
+It has already been fixed in XEmacs since 1999-12-06."
(if (and for-effect (memq (car-safe form) '(and or)))
- ;; Fix bug in and/or forms.
(let ((fn (car form))
(backwards (reverse (cdr form))))
(while (and backwards
(if (and (cdr form) (null backwards))
(byte-compile-log
" all subforms of %s called for effect; deleted" form))
- (if backwards
- (let ((head backwards))
- (while (setq backwards (cdr backwards))
- (setcar backwards (byte-optimize-form (car backwards)
- nil)))
- (cons fn (nreverse head)))))
- (si:byte-optimize-form-code-walker form for-effect)))
- (byte-compile 'byte-optimize-form-code-walker))
+ (when backwards
+ (setcdr backwards
+ (mapcar 'byte-optimize-form (cdr backwards))))
+ (setq ad-return-value (cons fn (nreverse backwards))))
+ ad-do-it)))
(condition-case nil
(char-after)
(load (expand-file-name "gnus-clfns.el" srcdir) nil t t)
(when (boundp 'MULE)
+ ;; Bind the function `base64-encode-string' before loading canlock.
+ ;; Since canlock will bind it as an autoloaded function, it causes
+ ;; damage to define the function by MEL.
+ (load (expand-file-name "base64.el" srcdir) nil t t)
;; Load special macros for compiling canlock.el.
(load (expand-file-name "canlock-om.el" srcdir) nil t t))
(error nil)))
(when (listp form)
(while form
- (setq elem (pop form))
+ (setq elem (car-safe form)
+ form (cdr-safe form))
(unless (memq (car-safe elem)
- '(\` backquote
- defcustom defface defgroup
+ '(defcustom defface defgroup
define-widget quote))
(while (consp elem)
(push (car elem) form)
(byte-compile 'dgnushack-bind-colon-keywords)
(dgnushack-bind-colon-keywords)))
-(if (boundp 'MULE)
- (progn
- (setq :version ':version
- :set-after ':set-after)
- (require 'custom)
- (defadvice custom-handle-keyword
- (around dont-signal-an-error-even-if-unsupported-keyword-is-given
- activate)
- "Don't signal an error even if unsupported keyword is given."
- (if (not (memq (ad-get-arg 1) '(:version :set-after)))
- ad-do-it))))
+(when (boundp 'MULE)
+ (setq :version ':version
+ :set-after ':set-after)
+ (require 'custom)
+ (defadvice custom-handle-keyword
+ (around dont-signal-an-error-even-if-unsupported-keyword-is-given
+ activate)
+ "Don't signal an error even if unsupported keyword is given."
+ (if (not (memq (ad-get-arg 1) '(:version :set-after)))
+ ad-do-it)))
(when (boundp 'MULE)
(put 'custom-declare-face 'byte-optimizer
(car (cdr args))))))
(setq args (cdr (cdr args))))
newform)
- form))))
+ form)))
+
+ (defadvice byte-compile-inline-expand (around ignore-built-in-functions
+ (form) activate)
+ "Ignore built-in functions."
+ (let* ((name (car form))
+ (fn (and (fboundp name)
+ (symbol-function name))))
+ (if (subrp fn)
+ ;; Give up on inlining.
+ (setq ad-return-value form)
+ ad-do-it))))
;; Unknown variables and functions.
(unless (boundp 'buffer-file-coding-system)
(unless (or (condition-case code
(require 'w3-parse)
(error
- (message "No w3: %s %s retrying..." code
- (locate-library "w3-parse"))
+ (message "No w3: %s%s, retrying..."
+ (error-message-string code)
+ (if (setq code (locate-library "w3-parse"))
+ (concat " (" code ")")
+ ""))
nil))
;; Maybe mis-configured Makefile is used (e.g.
;; configured for FSFmacs but XEmacs is running).
(condition-case code
(progn (require 'mh-e) nil)
(error
- (message "No mh-e: %s %s (ignored)" code (locate-library "mh-e"))
+ (message "No mh-e: %s%s (ignored)"
+ (error-message-string code)
+ (if (setq code (locate-library "mh-e"))
+ (concat " (" code ")")
+ ""))
'("gnus-mh.el")))
(condition-case code
(progn (require 'xml) nil)
(error
- (message "No xml: %s %s (ignored)" code (locate-library "xml"))
+ (message "No xml: %s%s (ignored)"
+ (error-message-string code)
+ (if (setq code (locate-library "xml"))
+ (concat " (" code ")")
+ ""))
'("nnrss.el")))
(condition-case code
(progn (require 'bbdb) nil)
(error
- (message "No bbdb: %s %s (ignored)" code (locate-library "bbdb"))
+ (message "No bbdb: %s%s (ignored)"
+ (error-message-string code)
+ (if (setq code (locate-library "bbdb"))
+ (concat " (" code ")")
+ ""))
'("gnus-bbdb.el")))
(unless (featurep 'xemacs)
- '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el" "smiley.el"))
- (when (or (featurep 'xemacs) (<= emacs-major-version 20))
- '("smiley-ems.el"))
+ '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el"))
+ (when (and (not (featurep 'xemacs))
+ (<= emacs-major-version 20))
+ '("smiley.el"))
(when (and (fboundp 'base64-decode-string)
(subrp (symbol-function 'base64-decode-string)))
'("base64.el"))
"Print name of files which will be installed."
(princ (mapconcat 'identity dgnushack-exporting-files " ")))
+(defconst dgnushack-dont-compile-files
+ '("mm-bodies.el" "mm-decode.el" "mm-encode.el" "mm-extern.el"
+ "mm-partial.el" "mm-url.el" "mm-uu.el" "mm-view.el" "mml-sec.el"
+ "mml-smime.el" "mml.el" "mml1991.el" "mml2015.el")
+ "Files which should not be byte-compiled.")
+
(defun dgnushack-compile (&optional warn)
;;(setq byte-compile-dynamic t)
(unless warn
(file-newer-than-file-p file elc))
(delete-file elc)))
+ ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet
+ ;; installed.
+ (when (featurep 'xemacs)
+ (setq gnus-xmas-glyph-directory "dummy"))
+
(let ((files dgnushack-exporting-files)
;;(byte-compile-generate-call-tree t)
file elc)
- ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet
- ;; installed.
- (when (featurep 'xemacs)
- (setq gnus-xmas-glyph-directory "dummy"))
(while (setq file (pop files))
- (setq file (expand-file-name file srcdir))
- (when (or (not (file-exists-p
- (setq elc (concat (file-name-nondirectory file) "c"))))
- (file-newer-than-file-p file elc))
- (ignore-errors
- (byte-compile-file file))))))
+ (unless (member file dgnushack-dont-compile-files)
+ (setq file (expand-file-name file srcdir))
+ (when (or (not (file-exists-p
+ (setq elc (concat (file-name-nondirectory file) "c"))))
+ (file-newer-than-file-p file elc))
+ (ignore-errors
+ (byte-compile-file file)))))))
(defun dgnushack-recompile ()
(require 'gnus)
projects / elisp / gnus.git- / blobdiff