shr: Render td content with shr-descend
[gnus] / lisp / dgnushack.el
index dc256bb..7274cb0 100644 (file)
 (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)))
 ;  (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)))
@@ -194,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)))
 
@@ -296,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
@@ -307,16 +261,15 @@ dgnushack-compile."
   ;;(setq byte-compile-dynamic t)
   (unless warn
     (setq byte-compile-warnings
-         '(free-vars unresolved callargs redefine)))
-  (let ((files (delete ".dir-locals.el"
-                      (directory-files srcdir nil "^[^=].*\\.el$")))
+         '(free-vars unresolved callargs redefine suspicious)))
+  (let ((files (directory-files srcdir nil "^[^=].*\\.el$"))
        ;;(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"))
-    (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)))
@@ -327,6 +280,8 @@ dgnushack-compile."
        (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") ""))
@@ -341,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))
@@ -377,7 +337,7 @@ dgnushack-compile."
     (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)
+       (if (string-match "\\(?:\\`\\|/\\)\\.dir-locals\\.el\\'" file)
            (setq ad-return-value (delete file ad-return-value)))))
     (unwind-protect
        (if (fboundp 'custom-make-dependencies)
@@ -390,20 +350,6 @@ dgnushack-compile."
 
 (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"))
@@ -415,7 +361,7 @@ dgnushack-compile."
     (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)
+       (if (string-match "\\(?:\\`\\|/\\)\\.dir-locals\\.el\\'" file)
            (setq ad-return-value (delete file ad-return-value)))))
     (unwind-protect
        (batch-update-autoloads)