X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-compat.el;h=130748853e68d3a8ef78389f2fe774f64f75ed41;hb=6910044663bc77081e08faabd6385cd34a9c8f5d;hp=2cca394dedd0ab21fbd54be802a7b97a3103ab54;hpb=81f7131c6375332dcc584797020db2e31f22d5d6;p=gnus diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el index 2cca394de..130748853 100644 --- a/lisp/gnus-compat.el +++ b/lisp/gnus-compat.el @@ -33,6 +33,7 @@ (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) @@ -40,6 +41,24 @@ 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)) @@ -57,6 +76,27 @@ TRASH is ignored." (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)))))) + (provide 'gnus-compat) ;; gnus-compat.el ends here