X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=17227e47fe0d7d8a5bbdfc31fd48f99222672e7a;hb=47bc3a7ccbdea93f85546cfac45ee9ebdb32d310;hp=ef06c7a23832cccc7d514e98b414259ab3e73581;hpb=7cb303c53006356be228d2bf9acd8042c57ba8a4;p=elisp%2Fgnus.git- diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index ef06c7a..17227e4 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -1,5 +1,5 @@ ;;; 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 @@ -86,6 +86,14 @@ (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) @@ -116,14 +124,21 @@ to the specified name LIBRARY (a la calling `load' instead of `load-library')." 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 @@ -133,14 +148,11 @@ to the specified name LIBRARY (a la calling `load' instead of `load-library')." (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) @@ -226,6 +238,10 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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)) @@ -331,10 +347,10 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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) @@ -364,17 +380,16 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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 @@ -419,7 +434,18 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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) @@ -443,8 +469,11 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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). @@ -467,23 +496,35 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (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" "gnus-picon.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")) @@ -504,6 +545,12 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. "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 @@ -529,20 +576,22 @@ Modify to suit your needs.")) (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)