X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fdgnushack.el;h=b174522eb3a7c228bdbdaefa4c3847a3d85606de;hb=eec20aecfb21c26e60d9a7f23267d15c1b40d7a1;hp=db52ce2b3e39f48bb5af9232b109117fd1cbd09b;hpb=5aa4a03b5caba1fa3617dfe1c896964de6712193;p=gnus diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index db52ce2b3..b174522eb 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, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -48,38 +48,6 @@ ;(push "/usr/share/emacs/site-lisp" load-path) -;; Define compiler macros for the functions provided by cl in old Emacsen. -(unless (featurep 'xemacs) - (define-compiler-macro butlast (&whole form x &optional n) - (if (>= emacs-major-version 21) - form - (if n - `(let ((x ,x) - (n ,n)) - (if (and n (<= n 0)) - x - (let ((m (length x))) - (or n (setq n 1)) - (and (< n m) - (progn - (if (> n 0) - (progn - (setq x (copy-sequence x)) - (setcdr (nthcdr (- (1- m) n) x) nil))) - x))))) - `(let* ((x ,x) - (m (length x))) - (and (< 1 m) - (progn - (setq x (copy-sequence x)) - (setcdr (nthcdr (- m 2) x) nil) - x)))))) - - (define-compiler-macro remove (&whole form item seq) - (if (>= emacs-major-version 21) - form - `(delete ,item (copy-sequence ,seq))))) - ;; If we are building w3 in a different directory than the source ;; directory, we must read *.el from source directory and write *.elc ;; into the building directory. For that, we define this function @@ -108,6 +76,43 @@ ; (cons 'progn (cdr form))) ;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun) +(when (and (not (featurep 'xemacs)) + (= emacs-major-version 21) + (= emacs-minor-version 3) + (condition-case code + (let ((byte-compile-error-on-warn t)) + (byte-optimize-form (quote (pop x)) t) + nil) + (error (string-match "called for effect" + (error-message-string code))))) + (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop + (form for-effect) + activate) + "Silence the warning \"...called for effect\" for the `pop' form. +It is effective only when the `pop' macro is defined by cl.el rather +than subr.el." + (let (tmp) + (if (and (eq (car-safe form) 'car) + for-effect + (setq tmp (get 'car 'side-effect-free)) + (not byte-compile-delete-errors) + (not (eq tmp 'error-free)) + (eq (car-safe (cadr form)) 'prog1) + (let ((var (cadr (cadr form))) + (last (nth 2 (cadr form)))) + (and (symbolp var) + (null (nthcdr 3 (cadr form))) + (eq (car-safe last) 'setq) + (eq (cadr last) var) + (eq (car-safe (nth 2 last)) 'cdr) + (eq (cadr (nth 2 last)) var)))) + (progn + (put 'car 'side-effect-free 'error-free) + (unwind-protect + ad-do-it + (put 'car 'side-effect-free tmp))) + ad-do-it)))) + (push srcdir load-path) (load (expand-file-name "lpath.el" srcdir) nil t) @@ -127,10 +132,7 @@ (eval-and-compile (when (featurep 'xemacs) - ;; XEmacs 21.1 needs some extra hand holding - (when (eq emacs-minor-version 1) - (autoload 'custom-declare-face "cus-face" nil t) - (autoload 'cl-compile-time-init "cl-macs" nil t) + (unless (fboundp 'defadvice) (autoload 'defadvice "advice" nil nil 'macro)) (autoload 'Info-directory "info" nil t) (autoload 'Info-menu "info" nil t) @@ -145,6 +147,7 @@ (autoload 'delete-annotation "annotations") (autoload 'dolist "cl-macs" nil nil 'macro) (autoload 'enriched-decode "enriched") + (autoload 'executable-find "executable") (autoload 'info "info" nil t) (autoload 'make-annotation "annotations") (autoload 'make-display-table "disp-table") @@ -251,15 +254,25 @@ Modify to suit your needs.")) (require 'gnus) (byte-recompile-directory "." 0)) -(defvar dgnushack-gnus-load-file (expand-file-name "gnus-load.el")) -(defvar dgnushack-cus-load-file (expand-file-name "cus-load.el")) +(defvar dgnushack-gnus-load-file + (if (featurep 'xemacs) + (expand-file-name "auto-autoloads.el") + (expand-file-name "gnus-load.el"))) + +(defvar dgnushack-cus-load-file + (if (featurep 'xemacs) + (expand-file-name "custom-load.el") + (expand-file-name "cus-load.el"))) (defun dgnushack-make-cus-load () (load "cus-dep") (let ((cusload-base-file dgnushack-cus-load-file)) (if (fboundp 'custom-make-dependencies) (custom-make-dependencies) - (Custom-make-dependencies)))) + (Custom-make-dependencies)) + (when (featurep 'xemacs) + (message "Compiling %s..." dgnushack-cus-load-file) + (byte-compile-file dgnushack-cus-load-file)))) (defun dgnushack-make-auto-load () (require 'autoload) @@ -288,43 +301,44 @@ Modify to suit your needs.")) (batch-update-autoloads))) (defun dgnushack-make-load () - (message (format "Generating %s..." dgnushack-gnus-load-file)) - (with-temp-file dgnushack-gnus-load-file - (insert-file-contents dgnushack-cus-load-file) - (delete-file dgnushack-cus-load-file) - (goto-char (point-min)) - (search-forward ";;; Code:") - (forward-line) - (delete-region (point-min) (point)) - (insert "\ + (unless (featurep 'xemacs) + (message "Generating %s..." dgnushack-gnus-load-file) + (with-temp-file dgnushack-gnus-load-file + (insert-file-contents dgnushack-cus-load-file) + (delete-file dgnushack-cus-load-file) + (goto-char (point-min)) + (search-forward ";;; Code:") + (forward-line) + (delete-region (point-min) (point)) + (insert "\ ;;; gnus-load.el --- automatically extracted custom dependencies and autoload ;; ;;; Code: ") - (goto-char (point-max)) - (if (search-backward "custom-versions-load-alist" nil t) + (goto-char (point-max)) + (if (search-backward "custom-versions-load-alist" nil t) + (forward-line -1) + (forward-line -1) + (while (eq (char-after) ?\;) + (forward-line -1)) + (forward-line)) + (delete-region (point) (point-max)) + (insert "\n") + ;; smiley-* are duplicated. Remove them all. + (let ((point (point))) + (insert-file-contents dgnushack-gnus-load-file) + (goto-char point) + (while (search-forward "smiley-" nil t) + (beginning-of-line) + (if (looking-at "(autoload ") + (delete-region (point) (progn (forward-sexp) (point))) + (forward-line)))) + ;; + (goto-char (point-max)) + (when (search-backward "\n(provide " nil t) (forward-line -1) - (forward-line -1) - (while (eq (char-after) ?\;) - (forward-line -1)) - (forward-line)) - (delete-region (point) (point-max)) - (insert "\n") - ;; smiley-* are duplicated. Remove them all. - (let ((point (point))) - (insert-file-contents dgnushack-gnus-load-file) - (goto-char point) - (while (search-forward "smiley-" nil t) - (beginning-of-line) - (if (looking-at "(autoload ") - (delete-region (point) (progn (forward-sexp) (point))) - (forward-line)))) - ;; - (goto-char (point-max)) - (when (search-backward "\n(provide " nil t) - (forward-line -1) - (delete-region (point) (point-max))) - (insert "\ + (delete-region (point) (point-max))) + (insert "\ \(provide 'gnus-load) @@ -335,18 +349,22 @@ Modify to suit your needs.")) ;;; End: ;;; gnus-load.el ends here ") - ;; Workaround the bug in some version of XEmacs. - (when (featurep 'xemacs) - (condition-case nil - (require 'cus-load) - (error nil)) - (goto-char (point-min)) - (when (and (fboundp 'custom-add-loads) - (not (search-forward "\n(autoload 'custom-add-loads " nil t))) - (search-forward "\n;;; Code:" nil t) - (forward-line 1) - (insert "\n(autoload 'custom-add-loads \"cus-load\")\n")))) - (message (format "Compiling %s..." dgnushack-gnus-load-file)) - (byte-compile-file dgnushack-gnus-load-file)) + )) + (message "Compiling %s..." dgnushack-gnus-load-file) + (byte-compile-file dgnushack-gnus-load-file) + (when (featurep 'xemacs) + (message "Creating dummy gnus-load.el...") + (with-temp-file (expand-file-name "gnus-load.el") + (insert "\ + +\(provide 'gnus-load) + +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: +;;; gnus-load.el ends here")))) + ;;; dgnushack.el ends here