X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=110e2e038d177a4cb95422048d49116b5ac87e2c;hp=de01fb2db111a193cc24da03cb69041eeaf9b006;hb=5193de49edd84a0e8d74e8289269b6055e14d6b1;hpb=b58d62328adf02b341b460a98819a54a0d629b60 diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index de01fb2db..110e2e038 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -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 ;; 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 . ;;; 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-. @@ -49,19 +50,18 @@ (require 'time-date) (require 'netrc) -(eval-and-compile - (autoload 'message-fetch-field "message") - (autoload 'gnus-get-buffer-window "gnus-win") - (autoload 'rmail-insert-rmail-file-header "rmail") - (autoload 'rmail-count-new-messages "rmail") - (autoload 'rmail-show-message "rmail") - (autoload 'nnheader-narrow-to-headers "nnheader") - (autoload 'nnheader-replace-chars-in-string "nnheader")) +(autoload 'message-fetch-field "message") +(autoload 'gnus-get-buffer-window "gnus-win") +(autoload 'rmail-insert-rmail-file-header "rmail") +(autoload 'rmail-count-new-messages "rmail") +(autoload 'rmail-show-message "rmail") +(autoload 'nnheader-narrow-to-headers "nnheader") +(autoload 'nnheader-replace-chars-in-string "nnheader") (eval-and-compile (cond ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5, - ;; SXEmacs 22.1.4) over `replace-in-string'. The later leads to inf-loops + ;; SXEmacs 22.1.4) over `replace-in-string'. The latter leads to inf-loops ;; on empty matches: ;; (replace-in-string "foo" "/*$" "/") ;; (replace-in-string "xe" "\\(x\\)?" "") @@ -192,6 +192,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 +223,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 +343,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: +;; | +;; | 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 . Allows to have ;; age-depending date representations. (e.g. just the time if it's @@ -471,7 +527,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 +710,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 +898,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 +912,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 @@ -889,10 +956,10 @@ If there's no subdirectory, delete DIRECTORY as well." (overlays-at pos))))))) ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 -;;; The primary idea here is to try to protect internal datastructures -;;; from becoming corrupted when the user hits C-g, or if a hook or -;;; similar blows up. Often in Gnus multiple tables/lists need to be -;;; updated at the same time, or information can be lost. +;; The primary idea here is to try to protect internal datastructures +;; from becoming corrupted when the user hits C-g, or if a hook or +;; similar blows up. Often in Gnus multiple tables/lists need to be +;; updated at the same time, or information can be lost. (defvar gnus-atomic-be-safe t "If t, certain operations will be protected from interruption by C-g.") @@ -911,7 +978,7 @@ variables and then do only the assignment atomically." (put 'gnus-atomic-progn 'lisp-indent-function 0) (defmacro gnus-atomic-progn-assign (protect &rest forms) - "Evaluate FORMS, but insure that the variables listed in PROTECT + "Evaluate FORMS, but ensure that the variables listed in PROTECT are not changed if anything in FORMS signals an error or otherwise non-locally exits. The variables listed in PROTECT are updated atomically. It is safe to use gnus-atomic-progn-assign with long computations. @@ -987,6 +1054,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 +1269,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 +1339,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 +1591,9 @@ CHOICE is a list of the choice char and help message at IDX." (kill-buffer buf)) tchar)) +(declare-function x-focus-frame "xfns.c" (frame)) +(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) @@ -1719,7 +1798,10 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; that intends to handle the quit signal next time. (eval '(ignore nil)))))) +(defalias 'gnus-read-shell-command + (if (fboundp 'read-shell-command) 'read-shell-command 'read-string)) + (provide 'gnus-util) -;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 +;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 ;;; gnus-util.el ends here