Merge from emacs--devo--0
[gnus] / lisp / gnus-util.el
index de01fb2..a327522 100644 (file)
@@ -1,27 +1,25 @@
 ;;; gnus-util.el --- utility functions for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -35,6 +33,9 @@
 
 ;;; 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-.
@@ -192,6 +193,15 @@ is slower."
                                   (match-end 0)))))
     (list (if (string= name "") nil name) (or address from))))
 
+(defun gnus-extract-address-component-name (from)
+  "Extract name from a From header.
+Uses `gnus-extract-address-components'."
+  (nth 0 (gnus-extract-address-components from)))
+
+(defun gnus-extract-address-component-email (from)
+  "Extract e-mail address from a From header.
+Uses `gnus-extract-address-components'."
+  (nth 1 (gnus-extract-address-components from)))
 
 (defun gnus-fetch-field (field)
   "Return the value of the header FIELD of current article."
@@ -214,6 +224,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)
@@ -327,15 +344,55 @@ Symbols are also allowed; their print names are used instead."
 
 ;; 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 functions?  Workarounds for bugs in the corresponding
+;; Emacs functions?  Maybe these bugs 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,
+;; 2007-12-14
+;;
+;; All supported Emacsen clear the echo area after `yes-or-no-p', so we can
+;; remove `yes-or-no-p'.  RMS says that not clearing after `y-or-n-p' is
+;; intentional (see below), so we could remove `gnus-y-or-n-p' too.
+;; Objections?  --rsteib, 2008-02-16
+;;
+;; ,----[ http://thread.gmane.org/gmane.emacs.gnus.general/65099/focus=66070 ]
+;; | From: Richard Stallman
+;; | Subject: Re: Do we need gnus-yes-or-no-p and gnus-y-or-n-p?
+;; | To: Katsumi Yamaoka [...]
+;; | Cc: emacs-devel@[...], xemacs-beta@[...], ding@[...]
+;; | Date: Mon, 07 Jan 2008 12:16:05 -0500
+;; | Message-ID: <E1JBva1-000528-VY@fencepost.gnu.org>
+;; |
+;; |     The behavior of `y-or-n-p' that it doesn't clear the question
+;; |     and the answer is not serious of course, but I feel it is not
+;; |     cool.
+;; |
+;; | It is intentional.
+;; |
+;; |     Currently, it is commented out in the trunk by Reiner Steib.  He
+;; |     also wrote the benefit of leaving the question and the answer in
+;; |     the echo area as follows:
+;; |
+;; |     (http://article.gmane.org/gmane.emacs.gnus.general/66061)
+;; |     > In contrast to yes-or-no-p it is much easier to type y, n,
+;; |     > SPC, DEL, etc accidentally, so it might be useful for the user
+;; |     > to see what he has typed.
+;; |
+;; | Yes, that is the reason.
+;; `----
+
+;; (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
@@ -471,7 +528,7 @@ If it is `log', add timestamps to only the messages that go into the
 \"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer).
 If it is neither nil nor `log', add timestamps not only to log messages
 but also to the ones displayed in the echo area."
-  :version "23.0" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :group  'gnus-various
   :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
                 (const :tag "Logged messages only" log)
@@ -654,6 +711,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)
@@ -838,6 +899,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
@@ -849,6 +913,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
@@ -987,6 +1055,9 @@ with potentially long computations."
 (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."
   (require 'rmail)
@@ -1199,6 +1270,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))
@@ -1266,6 +1340,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."
@@ -1515,6 +1592,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)
@@ -1721,5 +1800,5 @@ is allowed once again.  (Immediately, if `inhibit-quit' is nil.)"
 
 (provide 'gnus-util)
 
-;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
+;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
 ;;; gnus-util.el ends here