X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=334f0eea7db4bc1921db88dc4cbf5c4aa6cda578;hb=f760648d27b25a395063b64e7294717757652f4f;hp=d101047280cbc28593e2ad522ca7abc8803e1975;hpb=9a8731d6dea8021a10dec1b42f382609336a9aa9;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index d10104728..334f0eea7 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -53,10 +53,6 @@ (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") @@ -206,8 +202,11 @@ Uses `gnus-extract-address-components'." 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)) @@ -228,13 +227,14 @@ Uses `gnus-extract-address-components'." (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 @@ -429,6 +429,20 @@ TIME defaults to the current time." (+ (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 @@ -455,10 +469,10 @@ respectively.") (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")) @@ -477,23 +491,9 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (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)) @@ -1070,23 +1070,15 @@ with potentially long computations." ;;; 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) @@ -1123,8 +1115,7 @@ FILENAME exists and is Babyl format." (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) @@ -1202,8 +1193,7 @@ FILENAME exists and is Babyl format." (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))) @@ -1282,8 +1272,7 @@ This function saves the current buffer." "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) @@ -1305,6 +1294,14 @@ Return the modified alist." (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) @@ -1580,11 +1577,9 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (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)) @@ -1899,5 +1894,4 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" (provide 'gnus-util) -;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 ;;; gnus-util.el ends here