;;; gnus-util.el --- utility functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defvar gnus-original-article-buffer)
(defvar gnus-user-agent)
-(require 'time-date)
-(require 'netrc)
-
-(autoload 'message-fetch-field "message")
(autoload 'gnus-get-buffer-window "gnus-win")
(autoload 'nnheader-narrow-to-headers "nnheader")
(autoload 'nnheader-replace-chars-in-string "nnheader")
Uses `gnus-extract-address-components'."
(nth 1 (gnus-extract-address-components from)))
+(declare-function message-fetch-field "message" (header &optional not-all))
+
(defun gnus-fetch-field (field)
"Return the value of the header FIELD of current article."
+ (require 'message)
(save-excursion
(save-restriction
(let ((inhibit-point-motion-hooks 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-decode "gnus-group" (string charset))
(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)
+ (require 'gnus-group)
(let ((method (or method (gnus-find-method-for-group group))))
(mapconcat (lambda (group)
(gnus-group-name-decode group (gnus-group-name-charset
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
(* (- (string-to-number days) 1) 3600 24))))
+(defmacro gnus-date-get-time (date)
+ "Convert DATE string to Emacs time.
+Cache the result as a text property stored in DATE."
+ ;; Either return the cached value...
+ `(let ((d ,date))
+ (if (equal "" d)
+ '(0 0)
+ (or (get-text-property 0 'gnus-time d)
+ ;; or compute the value...
+ (let ((time (safe-date-to-time d)))
+ ;; and store it back in the string.
+ (put-text-property 0 1 'gnus-time time d)
+ time)))))
+
(defvar gnus-user-date-format-alist
'(((gnus-seconds-today) . "%k:%M")
(604800 . "%a %k:%M") ;;that's one week
(defun gnus-user-date (messy-date)
"Format the messy-date according to gnus-user-date-format-alist.
-Returns \" ? \" if there's bad input or if an other error occurs.
+Returns \" ? \" if there's bad input or if another error occurs.
Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
(condition-case ()
- (let* ((messy-date (gnus-float-time (safe-date-to-time messy-date)))
+ (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
(now (gnus-float-time))
;;If we don't find something suitable we'll use this one
(my-format "%b %d '%y"))
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string."
(condition-case ()
- (format-time-string "%d-%b" (safe-date-to-time messy-date))
+ (format-time-string "%d-%b" (gnus-date-get-time messy-date))
(error " - ")))
-(defmacro gnus-date-get-time (date)
- "Convert DATE string to Emacs time.
-Cache the result as a text property stored in DATE."
- ;; Either return the cached value...
- `(let ((d ,date))
- (if (equal "" d)
- '(0 0)
- (or (get-text-property 0 'gnus-time d)
- ;; or compute the value...
- (let ((time (safe-date-to-time d)))
- ;; and store it back in the string.
- (put-text-property 0 1 'gnus-time time d)
- time)))))
-
(defsubst gnus-time-iso8601 (time)
"Return a string of TIME in YYYYMMDDTHHMMSS format."
(format-time-string "%Y%m%dT%H%M%S" time))
;;; Functions for saving to babyl/mail files.
(eval-when-compile
- (condition-case nil
- (progn
- (require 'rmail)
- (autoload 'rmail-update-summary "rmailsum"))
- (error
- (define-compiler-macro rmail-select-summary (&rest body)
- ;; Rmail of the XEmacs version is supplied by the package, and
- ;; requires tm and apel packages. However, there may be those
- ;; who haven't installed those packages. This macro helps such
- ;; people even if they install those packages later.
- `(eval '(rmail-select-summary ,@body)))
- ;; If there's rmail but there's no tm (or there's apel of the
- ;; mainstream, not the XEmacs version), loading rmail of the XEmacs
- ;; 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"))))
+ (if (featurep 'xemacs)
+ ;; Don't load tm and apel XEmacs packages that provide some
+ ;; Emacs emulating functions and variables.
+ (let ((features features))
+ (provide 'tm-view)
+ (unless (fboundp 'set-alist) (defalias 'set-alist 'ignore))
+ (require 'rmail)) ;; It requires tm-view that loads apel.
+ (require 'rmail))
+ (autoload 'rmail-update-summary "rmailsum"))
(defvar mm-text-coding-system)
(gnus-yes-or-no-p
(concat "\"" filename "\" does not exist, create it? ")))
(let ((file-buffer (create-file-buffer filename)))
- (save-excursion
- (set-buffer file-buffer)
+ (with-current-buffer file-buffer
(if (fboundp 'rmail-insert-rmail-file-header)
(rmail-insert-rmail-file-header))
(let ((require-final-newline nil)
(gnus-y-or-n-p
(concat "\"" filename "\" does not exist, create it? ")))
(let ((file-buffer (create-file-buffer filename)))
- (save-excursion
- (set-buffer file-buffer)
+ (with-current-buffer file-buffer
(let ((require-final-newline nil)
(coding-system-for-write mm-text-coding-system))
(gnus-write-buffer filename)))
"Say whether Gnus is running or not."
(and (boundp 'gnus-group-buffer)
(get-buffer gnus-group-buffer)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(eq major-mode 'gnus-group-mode))))
(defun gnus-remove-if (predicate list)
(setq alist (delq entry alist)))
alist)))
+(defun gnus-grep-in-list (word list)
+ "Find if a WORD matches any regular expression in the given LIST."
+ (when (and word list)
+ (catch 'found
+ (dolist (r list)
+ (when (string-match r word)
+ (throw 'found r))))))
+
(defmacro gnus-pull (key alist &optional assoc-p)
"Modify ALIST to be without KEY."
(unless (symbolp alist)
(car (symbol-value history))))
(defun gnus-graphic-display-p ()
- (or (and (fboundp 'display-graphic-p)
- (display-graphic-p))
- ;;;!!!This is bogus. Fixme!
- (and (featurep 'xemacs)
- t)))
+ (if (featurep 'xemacs)
+ (device-on-window-system-p)
+ (display-graphic-p)))
(put 'gnus-parse-without-error 'lisp-indent-function 0)
(put 'gnus-parse-without-error 'edebug-form-spec '(body))
(provide 'gnus-util)
-;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
;;; gnus-util.el ends here
projects / gnus / blobdiff