Merge from emacs--devo--0
[gnus] / lisp / gnus-util.el
index 56c9b25..56aacf0 100644 (file)
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 
 ;;; Code:
 
+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
-  (require 'cl)
-  ;; Fixme: this should be a gnus variable, not nnmail-.
-  (defvar nnmail-pathname-coding-system)
-  (defvar nnmail-active-file-coding-system)
-
-  ;; Inappropriate references to other parts of Gnus.
-  (defvar gnus-emphasize-whitespace-regexp)
-  (defvar gnus-original-article-buffer)
-  (defvar gnus-user-agent)
-  )
+  (require 'cl))
+;; Fixme: this should be a gnus variable, not nnmail-.
+(defvar nnmail-pathname-coding-system)
+(defvar nnmail-active-file-coding-system)
+
+;; Inappropriate references to other parts of Gnus.
+(defvar gnus-emphasize-whitespace-regexp)
+(defvar gnus-original-article-buffer)
+(defvar gnus-user-agent)
+
 (require 'time-date)
 (require 'netrc)
 
@@ -214,6 +217,13 @@ is slower."
                   (search-forward ":" eol t)
                   (point)))))
 
+(declare-function gnus-find-method-for-group "gnus" (group &optional info))
+(autoload 'gnus-group-name-decode "gnus-group")
+(declare-function gnus-group-name-charset "gnus-group" (method group))
+;; gnus-group requires gnus-int which requires message.
+(declare-function message-tokenize-header "message"
+                  (header &optional separator))
+
 (defun gnus-decode-newsgroups (newsgroups group &optional method)
   (let ((method (or method (gnus-find-method-for-group group))))
     (mapconcat (lambda (group)
@@ -254,6 +264,15 @@ is slower."
   (not (or (string< s1 s2)
           (string= s1 s2))))
 
+(defun gnus-string< (s1 s2)
+  "Return t if first arg string is less than second in lexicographic order.
+Case is significant if and only if `case-fold-search' is nil.
+Symbols are also allowed; their print names are used instead."
+  (if case-fold-search
+      (string-lessp (downcase (if (symbolp s1) (symbol-name s1) s1))
+                   (downcase (if (symbolp s2) (symbol-name s2) s2)))
+    (string-lessp s1 s2)))
+
 ;;; Time functions.
 
 (defun gnus-file-newer-than (file date)
@@ -318,15 +337,23 @@ is slower."
 
 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
 ;; the echo area.
-(defun gnus-y-or-n-p (prompt)
-  (prog1
-      (y-or-n-p prompt)
-    (message "")))
-
-(defun gnus-yes-or-no-p (prompt)
-  (prog1
-      (yes-or-no-p prompt)
-    (message "")))
+;;
+;; Do we really need these aliases?  Workarounds for bugs in the corresponding
+;; Emacs functions?  Maybe these bug are no longer present in any supported
+;; (X)Emacs version?  Alias them to the original functions and see if anyone
+;; reports a problem.  If not, replace with original functions.  --rsteib
+;;
+;; (defun gnus-y-or-n-p (prompt)
+;;   (prog1
+;;       (y-or-n-p prompt)
+;;     (message "")))
+;; (defun gnus-yes-or-no-p (prompt)
+;;   (prog1
+;;       (yes-or-no-p prompt)
+;;     (message "")))
+
+(defalias 'gnus-y-or-n-p 'y-or-n-p)
+(defalias 'gnus-yes-or-no-p 'yes-or-no-p)
 
 ;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have
 ;; age-depending date representations. (e.g. just the time if it's
@@ -645,6 +672,10 @@ If N, return the Nth ancestor instead."
 
 (defvar gnus-work-buffer " *gnus work*")
 
+(declare-function gnus-get-buffer-create "gnus" (name))
+;; gnus.el requires mm-util.
+(declare-function mm-enable-multibyte "mm-util")
+
 (defun gnus-set-work-buffer ()
   "Put point in the empty Gnus work buffer."
   (if (get-buffer gnus-work-buffer)
@@ -829,6 +860,9 @@ If there's no subdirectory, delete DIRECTORY as well."
     (setq string (replace-match "" t t string)))
   string)
 
+(declare-function gnus-put-text-property "gnus"
+                  (start end property value &optional object))
+
 (defsubst gnus-put-text-property-excluding-newlines (beg end prop val)
   "The same as `put-text-property', but don't put this prop on any newlines in the region."
   (save-match-data
@@ -840,6 +874,10 @@ If there's no subdirectory, delete DIRECTORY as well."
          (setq beg (point)))
        (gnus-put-text-property beg (point) prop val)))))
 
+(declare-function gnus-overlay-put  "gnus" (overlay prop value))
+(declare-function gnus-make-overlay "gnus"
+                  (beg end &optional buffer front-advance rear-advance))
+
 (defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
   "The same as `put-text-property', but don't put this prop on any newlines in the region."
   (save-match-data
@@ -973,9 +1011,13 @@ with potentially long computations."
      ;; version fails halfway, however it provides the rmail-select-summary
      ;; macro which uses the following functions:
      (autoload 'rmail-summary-displayed "rmail")
-     (autoload 'rmail-maybe-display-summary "rmail")))
-  (defvar rmail-default-rmail-file)
-  (defvar mm-text-coding-system))
+     (autoload 'rmail-maybe-display-summary "rmail"))))
+
+(defvar rmail-default-rmail-file)
+(defvar mm-text-coding-system)
+
+(declare-function mm-append-to-file "mm-util"
+                  (start end filename &optional codesys inhibit))
 
 (defun gnus-output-to-rmail (filename &optional ask)
   "Append the current article to an Rmail file named FILENAME."
@@ -1158,7 +1200,7 @@ Return the modified alist."
     `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
 
 (defun gnus-globalify-regexp (re)
-  "Return a regexp that matches a whole line, iff RE matches a part of it."
+  "Return a regexp that matches a whole line, if RE matches a part of it."
   (concat (unless (string-match "^\\^" re) "^.*")
          re
          (unless (string-match "\\$$" re) ".*$")))
@@ -1189,6 +1231,9 @@ Return the modified alist."
        (throw 'found nil)))
     t))
 
+;; gnus.el requires mm-util.
+(declare-function mm-disable-multibyte "mm-util")
+
 (defun gnus-write-active-file (file hashtb &optional full-names)
   ;; `coding-system-for-write' should be `raw-text' or equivalent.
   (let ((coding-system-for-write nnmail-active-file-coding-system))
@@ -1256,6 +1301,9 @@ Return the modified alist."
             (pop l2))
           l1))))
 
+(declare-function gnus-add-text-properties "gnus"
+                  (start end properties &optional object))
+
 (defun gnus-add-text-properties-when
   (property value start end properties &optional object)
   "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1505,6 +1553,8 @@ CHOICE is a list of the choice char and help message at IDX."
        (kill-buffer buf))
     tchar))
 
+(declare-function w32-focus-frame "../term/w32-win" (frame))
+
 (defun gnus-select-frame-set-input-focus (frame)
   "Select FRAME, raise it, and set input focus, if possible."
   (cond ((featurep 'xemacs)
@@ -1542,8 +1592,7 @@ Return nil otherwise."
                                 display))
              display)))))
 
-(eval-when-compile
-  (defvar tool-bar-mode))
+(defvar tool-bar-mode)
 
 (defun gnus-tool-bar-update (&rest ignore)
   "Update the tool bar."
@@ -1612,10 +1661,9 @@ predicate on the elements."
          (push (pop list1) res)))
       (nconc (nreverse res) list1 list2))))
 
-(eval-when-compile
-  (defvar xemacs-codename)
-  (defvar sxemacs-codename)
-  (defvar emacs-program-version))
+(defvar xemacs-codename)
+(defvar sxemacs-codename)
+(defvar emacs-program-version)
 
 (defun gnus-emacs-version ()
   "Stringified Emacs version."