mm-util.el (mm-ucs-to-char): Use eval-and-compile.
[gnus] / lisp / dgnushack.el
index caaaf05..7274cb0 100644 (file)
@@ -1,6 +1,6 @@
 ;;; dgnushack.el --- a hack to set the load path for byte-compiling
 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003,
-;; 2004, 2005, 2006, 2007, 2008
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 (defalias 'facep 'ignore)
 
 (require 'cl)
+(require 'iswitchb)
+
+(condition-case nil
+    (require 'org-entities)
+  (error nil))
 
 (defvar srcdir (or (getenv "srcdir") "."))
 (defvar loaddir (and load-file-name (file-name-directory load-file-name)))
@@ -62,7 +67,7 @@
   (setq filename (byte-compiler-base-file-name filename))
   (setq filename (file-name-sans-versions filename))
   (setq filename (file-name-nondirectory filename))
-  (if (memq system-type '(win32 w32 mswindows windows-nt))
+  (if (eq system-type 'windows-nt)
       (setq filename (downcase filename)))
   (cond ((eq system-type 'vax-vms)
         (concat (substring filename 0 (string-match ";" filename)) "c"))
 ;  (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))))
-
-(when (and (not (featurep 'xemacs))
-          (byte-optimize-form
-           '(and (> 0 1)
-                 (message "This should not appear in the byte-code."))
-           t))
-  (defadvice byte-optimize-form-code-walker
-    (around fix-bug-in-and/or-forms (form for-effect) activate)
-    "Optimize the rest of the and/or forms.
-It has been fixed in XEmacs before releasing 21.4 and also has been
-fixed in Emacs 22."
-    (if (and for-effect (memq (car-safe form) '(and or)))
-       (let ((fn (car form))
-             (backwards (reverse (cdr form))))
-         (while (and backwards
-                     (null (setcar backwards
-                                   (byte-optimize-form (car backwards) t))))
-           (setq backwards (cdr backwards)))
-         (if (and (cdr form) (null backwards))
-             (byte-compile-log
-              "  all subforms of %s called for effect; deleted" form))
-         (when backwards
-           (setcdr backwards
-                   (mapcar 'byte-optimize-form (cdr backwards))))
-         (setq ad-return-value (cons fn (nreverse backwards))))
-      ad-do-it)))
-
 ;; Work around for an incompatibility (XEmacs 21.4 vs. 21.5), see the
 ;; following threads:
 ;;
@@ -169,7 +111,7 @@ fixed in Emacs 22."
                 (forward-sexp 1)
                 (eolp)))))
   ;; The original `with-syntax-table' uses `copy-syntax-table' which
-  ;; doesn't seem to copy modified syntax entries in XEmacs 21.5.
+  ;; doesn't seem to copy modified syntax entries in old XEmacs 21.5.
   (defmacro with-syntax-table (syntab &rest body)
     "Evaluate BODY with the SYNTAB as the current syntax table."
     `(let ((stab (syntax-table)))
@@ -186,7 +128,6 @@ fixed in Emacs 22."
 
 (defalias 'device-sound-enabled-p 'ignore)
 (defalias 'play-sound-file 'ignore)
-(defalias 'nndb-request-article 'ignore)
 (defalias 'efs-re-read-dir 'ignore)
 (defalias 'ange-ftp-re-read-dir 'ignore)
 (defalias 'define-mail-user-agent 'ignore)
@@ -195,6 +136,8 @@ fixed in Emacs 22."
   (unless (featurep 'xemacs)
     (defalias 'get-popup-menu-response 'ignore)
     (defalias 'event-object 'ignore)
+    (autoload 'iswitchb-read-buffer "iswitchb")
+    (autoload 'netrc-credentials "netrc")
     (defalias 'x-defined-colors 'ignore)
     (defalias 'read-color 'ignore)))
 
@@ -207,6 +150,10 @@ fixed in Emacs 22."
     (autoload 'Info-index-next "info" nil t)
     (autoload 'Info-menu "info" nil t)
     (autoload 'ad-add-advice "advice")
+    (unless (and (emacs-version>= 21 5)
+                (not (featurep 'sxemacs)))
+      ;; calendar/auto-autoloads.el provides it.
+      (autoload 'add-to-invisibility-spec "dummy"))
     (autoload 'annotations-at "annotations")
     (autoload 'apropos "apropos" nil t)
     (autoload 'apropos-command "apropos" nil t)
@@ -293,6 +240,16 @@ in `defcustom' forms."
   (maybe-fbind '(defined-colors face-attribute))
   (maybe-bind '(idna-program installation-directory)))
 
+(when (featurep 'xemacs)
+  (defadvice byte-optimize-apply (before use-mapcan (form) activate)
+    "Replace (apply 'nconc (mapcar ...)) with (mapcan ...)."
+    (let ((last (nth (1- (length form)) form)))
+      (when (and (eq last (third form))
+                (consp last)
+                (eq 'mapcar (car last))
+                (equal (nth 1 form) ''nconc))
+       (setq form (cons 'mapcan (cdr last)))))))
+
 (defun dgnushack-compile-verbosely ()
   "Call dgnushack-compile with warnings ENABLED.  If you are compiling
 patches to gnus, you should consider modifying make.bat to call
@@ -304,7 +261,7 @@ dgnushack-compile."
   ;;(setq byte-compile-dynamic t)
   (unless warn
     (setq byte-compile-warnings
-         '(free-vars unresolved callargs redefine)))
+         '(free-vars unresolved callargs redefine suspicious)))
   (let ((files (directory-files srcdir nil "^[^=].*\\.el$"))
        ;;(byte-compile-generate-call-tree t)
        file elc)
@@ -312,7 +269,7 @@ dgnushack-compile."
     ;; installed.
     (when (featurep 'xemacs)
       (setq gnus-xmas-glyph-directory "dummy"))
-    (dolist (file '("dgnushack.el" "lpath.el"))
+    (dolist (file '(".dir-locals.el" "dgnushack.el" "lpath.el"))
       (setq files (delete file files)))
     (when (featurep 'base64)
       (setq files (delete "base64.el" files)))
@@ -320,9 +277,11 @@ dgnushack-compile."
        (require 'w3-parse)
       (error
        (message "No w3: %s %s" (cadr code) (or (locate-library "w3-parse") ""))
-       (dolist (file '("nnultimate.el" "webmail.el" "nnwfm.el"))
+       (dolist (file '("webmail.el" "nnwfm.el"))
         (setq files (delete file files)))))
     (condition-case code
+       ;; Under XEmacs 21.4 this loads easy-mmode.elc that provides
+       ;; the Emacs functions `propertize' and `replace-regexp-in-string'.
        (require 'mh-e)
       (error
        (message "No mh-e: %s %s" (cadr code) (or (locate-library "mh-e") ""))
@@ -337,6 +296,11 @@ dgnushack-compile."
                 '("md5.el")
               '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")))
       (setq files (delete file files)))
+    (unless (and (fboundp 'libxml-parse-html-region)
+                ;; lpath.el binds it.
+                (not (eq (symbol-function 'libxml-parse-html-region)
+                         'ignore)))
+      (setq files (delete "shr-color.el" (delete "shr.el" files))))
 
     (dolist (file files)
       (setq file (expand-file-name file srcdir))
@@ -362,7 +326,7 @@ dgnushack-compile."
       (expand-file-name "auto-autoloads.el")
     (expand-file-name "gnus-load.el")))
 
-(defvar        dgnushack-cus-load-file 
+(defvar        dgnushack-cus-load-file
   (if (featurep 'xemacs)
       (expand-file-name "custom-load.el")
     (expand-file-name "cus-load.el")))
@@ -370,29 +334,22 @@ dgnushack-compile."
 (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))
+    (defadvice directory-files (after exclude-dir-locals activate)
+      "Exclude .dir-locals.el file."
+      (dolist (file ad-return-value)
+       (if (string-match "\\(?:\\`\\|/\\)\\.dir-locals\\.el\\'" file)
+           (setq ad-return-value (delete file ad-return-value)))))
+    (unwind-protect
+       (if (fboundp 'custom-make-dependencies)
+           (custom-make-dependencies)
+         (Custom-make-dependencies))
+      (ad-unadvise 'directory-files))
     (when (featurep 'xemacs)
       (message "Compiling %s..." dgnushack-cus-load-file)
       (byte-compile-file dgnushack-cus-load-file))))
 
 (defun dgnushack-make-auto-load ()
   (require 'autoload)
-  (unless (make-autoload '(define-derived-mode child parent name
-                           "docstring" body)
-                        "file")
-    (defadvice make-autoload (around handle-define-derived-mode activate)
-      "Handle `define-derived-mode'."
-      (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode)
-         (setq ad-return-value
-               (list 'autoload
-                     (list 'quote (nth 1 (ad-get-arg 0)))
-                     (ad-get-arg 1)
-                     (nth 4 (ad-get-arg 0))
-                     t nil))
-       ad-do-it))
-    (put 'define-derived-mode 'doc-string-elt 3))
   (let ((generated-autoload-file dgnushack-gnus-load-file)
        (make-backup-files nil)
        (autoload-package-name "gnus"))
@@ -401,7 +358,14 @@ dgnushack-compile."
            (delete-file generated-autoload-file))
       (with-temp-file generated-autoload-file
        (insert ?\014)))
-    (batch-update-autoloads)))
+    (defadvice directory-files (after exclude-dir-locals activate)
+      "Exclude .dir-locals.el file."
+      (dolist (file ad-return-value)
+       (if (string-match "\\(?:\\`\\|/\\)\\.dir-locals\\.el\\'" file)
+           (setq ad-return-value (delete file ad-return-value)))))
+    (unwind-protect
+       (batch-update-autoloads)
+      (ad-unadvise 'directory-files))))
 
 (defun dgnushack-make-load ()
   (unless (featurep 'xemacs)
@@ -547,5 +511,3 @@ or remove them using `make remove-installed-shadows'.\n\n"))))))))
        (setq path (cdr path))))))
 
 ;;; dgnushack.el ends here
-
-;;; arch-tag: 579f585a-24eb-4e1c-8d34-4808e11b68f2