gnus-notifications: add actions support

[gnus] / lisp / gnus-compat.el

diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el
index db2c452..2b25e45 100644 (file)
--- a/lisp/gnus-compat.el
+++ b/lisp/gnus-compat.el
@@ -28,11 +28,82 @@
 ;; functions "missing" in other Emacs instances, and redefine other
 ;; functions to work like the Emacs trunk versions.
 
-(provide 'gnus-compat)
+(eval-when-compile (require 'cl))
+
+(ignore-errors
+  (require 'help-fns))
 
+;; XEmacs doesn't have this function.
 (when (and (not (fboundp 'help-function-arglist))
           (fboundp 'function-arglist))
   (defun help-function-arglist (def &optional preserve-names)
+    "Return a formal argument list for the function DEF.
+PRESERVE-NAMES is ignored."
     (cdr (car (read-from-string (downcase (function-arglist def)))))))
 
+;; Modify this function on Emacs 23.1 and earlier to always return the
+;; right answer.
+(when (and (fboundp 'help-function-arglist)
+          (eq (help-function-arglist 'car) t))
+  (defvar gnus-compat-original-help-function-arglist
+    (symbol-function 'help-function-arglist))
+  (defun help-function-arglist (def &optional preserve-names)
+    "Return a formal argument list for the function DEF.
+PRESERVE-NAMES is ignored."
+    (let ((orig (funcall gnus-compat-original-help-function-arglist def)))
+      (if (not (eq orig t))
+         orig
+       ;; Built-in subrs have the arglist hidden in the doc string.
+       (let ((doc (documentation def)))
+         (when (and doc
+                    (string-match "\n\n\\((fn\\( .*\\)?)\\)\\'" doc))
+           (cdr (car (read-from-string (downcase (match-string 1 doc)))))))))))
+
+(when (= (length (help-function-arglist 'delete-directory)) 1)
+  (defvar gnus-compat-original-delete-directory
+    (symbol-function 'delete-directory))
+  (defun delete-directory (directory &optional recursive trash)
+    "Delete the directory named DIRECTORY.  Does not follow symlinks.
+If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well.
+TRASH is ignored."
+    (interactive "DDirectory: ")
+    (if (not recursive)
+       (funcall gnus-compat-original-delete-directory directory)
+      (dolist (file (directory-files directory t))
+       (unless (member (file-name-nondirectory file) '("." ".."))
+         (if (file-directory-p file)
+             (delete-directory file t)
+           (delete-file file))))
+      (delete-directory directory))))
+
+;; Emacs 24.0.93
+(require 'url)
+(when (= (length (help-function-arglist 'url-retrieve)) 5)
+  (defvar gnus-compat-original-url-retrieve
+    (symbol-function 'url-retrieve))
+  (defun url-retrieve (url callback &optional cbargs silent inhibit-cookies)
+    "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished."
+    (funcall gnus-compat-original-url-retrieve
+            url callback cbargs silent)))
+
+;; XEmacs
+(when (and (not (fboundp 'timer-set-function))
+          (fboundp 'set-itimer-function))
+  (defun timer-set-function (timer function &optional args)
+    "Make TIMER call FUNCTION with optional ARGS when triggering."
+    (lexical-let ((function function)
+                 (args args))
+      (set-itimer-function timer
+                          (lambda (process status)
+                            (apply function process status args))))))
+
+;; XEmacs 21.4
+(unless (fboundp 'bound-and-true-p)
+  (defmacro bound-and-true-p (var)
+    "Return the value of symbol VAR if it is bound, else nil."
+    (and (boundp var)
+        (symbol-value var))))
+
+(provide 'gnus-compat)
+
 ;; gnus-compat.el ends here