X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=334f0eea7db4bc1921db88dc4cbf5c4aa6cda578;hp=8a6e8fa71cb005b624542d02964bd34791991ba5;hb=06e3d74faa6b1196f0a7b877acc1bb6b6c1563a8;hpb=140d2fa92387996fba24ca96e80e2cfadf7bb346 diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 8a6e8fa71..334f0eea7 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, 2009, 2010 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: @@ -40,6 +38,12 @@ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) + +(eval-when-compile + (unless (fboundp 'with-no-warnings) + (defmacro with-no-warnings (&rest body) + `(progn ,@body)))) + ;; Fixme: this should be a gnus variable, not nnmail-. (defvar nnmail-pathname-coding-system) (defvar nnmail-active-file-coding-system) @@ -49,22 +53,15 @@ (defvar gnus-original-article-buffer) (defvar gnus-user-agent) -(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 'gnus-get-buffer-window "gnus-win") +(autoload 'nnheader-narrow-to-headers "nnheader") +(autoload 'nnheader-replace-chars-in-string "nnheader") +(autoload 'mail-header-remove-comments "mail-parse") (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\\)?" "") @@ -195,9 +192,21 @@ 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))) + +(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)) @@ -217,7 +226,15 @@ is slower." (search-forward ":" eol t) (point))))) +(declare-function gnus-find-method-for-group "gnus" (group &optional info)) +(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 @@ -274,6 +291,15 @@ Symbols are also allowed; their print names are used instead." (and (= (car fdate) (car date)) (> (nth 1 fdate) (nth 1 date)))))) +(eval-and-compile + (if (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defalias 'gnus-float-time 'float-time) + (defun gnus-float-time (&optional time) + "Convert time value TIME to a floating point number. +TIME defaults to the current time." + (with-no-warnings (time-to-seconds (or time (current-time))))))) + ;;; Keymap macros. (defmacro gnus-local-set-keys (&rest plist) @@ -330,15 +356,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 @@ -363,6 +429,20 @@ Symbols are also allowed; their print names are used instead." (+ (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 @@ -389,11 +469,11 @@ 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 (time-to-seconds (safe-date-to-time messy-date))) - (now (time-to-seconds (current-time))) + (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")) (let* ((difference (- now messy-date)) @@ -411,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)) @@ -474,7 +540,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) @@ -572,7 +638,7 @@ ARGS are passed to `message'." (defun gnus-split-references (references) "Return a list of Message-IDs in REFERENCES." (let ((beg 0) - (references (or references "")) + (references (mail-header-remove-comments (or references ""))) ids) (while (string-match "<[^<]+[^< \t]" references beg) (push (substring references (match-beginning 0) (setq beg (match-end 0))) @@ -599,8 +665,9 @@ If N, return the Nth ancestor instead." (while (nthcdr n ids) (setq ids (cdr ids))) (car ids)) - (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) - (match-string 1 references))))) + (let ((references (mail-header-remove-comments references))) + (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) + (match-string 1 references)))))) (defun gnus-buffer-live-p (buffer) "Say whether BUFFER is alive or not." @@ -657,6 +724,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) @@ -841,6 +912,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 @@ -852,6 +926,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 @@ -891,11 +969,34 @@ If there's no subdirectory, delete DIRECTORY as well." (overlay-get overlay 'face)) (overlays-at pos))))))) +(if (fboundp 'invisible-p) + (defalias 'gnus-invisible-p 'invisible-p) + ;; for Emacs < 22.2, and XEmacs. + (defun gnus-invisible-p (pos) + "Return non-nil if the character after POS is currently invisible." + (let ((prop (get-char-property pos 'invisible))) + (if (eq buffer-invisibility-spec t) + prop + (or (memq prop buffer-invisibility-spec) + (assq prop buffer-invisibility-spec)))))) + +;; Note: the optional 2nd argument has a different meaning between +;; Emacs and XEmacs. +;; (next-char-property-change POSITION &optional LIMIT) +;; (next-extent-change POS &optional OBJECT) +(defalias 'gnus-next-char-property-change + (if (fboundp 'next-extent-change) + 'next-extent-change 'next-char-property-change)) + +(defalias 'gnus-previous-char-property-change + (if (fboundp 'previous-extent-change) + 'previous-extent-change 'previous-char-property-change)) + ;;; 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.") @@ -914,7 +1015,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. @@ -969,49 +1070,54 @@ 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")))) - -(defvar rmail-default-rmail-file) + (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) (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." + "Append the current article to an Rmail file named FILENAME. +In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless +FILENAME exists and is Babyl format." (require 'rmail) (require 'mm-util) - ;; Most of these codes are borrowed from rmailout.el. + ;; Some of this codes is borrowed from rmailout.el. (setq filename (expand-file-name filename)) - (setq rmail-default-rmail-file filename) + ;; FIXME should we really be messing with this defcustom? + ;; It is not needed for the operation of this function. + (if (boundp 'rmail-default-rmail-file) + (setq rmail-default-rmail-file filename) ; 22 + (setq rmail-default-file filename)) ; 23 (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) + (tmpbuf (get-buffer-create " *Gnus-output*")) + ;; Babyl rmail.el defines this, mbox does not. + (babyl (fboundp 'rmail-insert-rmail-file-header))) (save-excursion - (or (get-file-buffer filename) - (file-exists-p filename) + ;; Note that we ignore the possibility of visiting a Babyl + ;; format buffer in Emacs 23, since Rmail no longer supports that. + (or (get-file-buffer filename) + (progn + ;; In case someone wants to write to a Babyl file from Emacs 23. + (when (file-exists-p filename) + (setq babyl (mail-file-babyl-p filename)) + t)) (if (or (not ask) (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) - (rmail-insert-rmail-file-header) + (with-current-buffer file-buffer + (if (fboundp 'rmail-insert-rmail-file-header) + (rmail-insert-rmail-file-header)) (let ((require-final-newline nil) (coding-system-for-write mm-text-coding-system)) (gnus-write-buffer filename))) @@ -1020,32 +1126,56 @@ with potentially long computations." (set-buffer tmpbuf) (erase-buffer) (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) + (if babyl + (gnus-convert-article-to-rmail) + ;; Non-Babyl case copied from gnus-output-to-mail. + (goto-char (point-min)) + (if (looking-at "From ") + (forward-line 1) + (insert "From nobody " (current-time-string) "\n")) + (let (case-fold-search) + (while (re-search-forward "^From " nil t) + (beginning-of-line) + (insert ">")))) ;; Decide whether to append to a file or to an Emacs buffer. (let ((outbuf (get-file-buffer filename))) (if (not outbuf) - (let ((file-name-coding-system nnmail-pathname-coding-system)) - (mm-append-to-file (point-min) (point-max) filename)) + (progn + (unless babyl ; from gnus-output-to-mail + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (forward-char -2) + (unless (looking-at "\n\n") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert "\n")))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (mm-append-to-file (point-min) (point-max) filename))) ;; File has been visited, in buffer OUTBUF. (set-buffer outbuf) (let ((buffer-read-only nil) (msg (and (boundp 'rmail-current-message) (symbol-value 'rmail-current-message)))) ;; If MSG is non-nil, buffer is in RMAIL mode. + ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. (when msg - (widen) - (narrow-to-region (point-max) (point-max))) + (unless babyl + (rmail-swap-buffers-maybe) + (rmail-maybe-set-message-counters)) + (widen) + (narrow-to-region (point-max) (point-max))) (insert-buffer-substring tmpbuf) (when msg - (goto-char (point-min)) - (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max)) + (when babyl + (goto-char (point-min)) + (widen) + (search-backward "\n\^_") + (narrow-to-region (point) (point-max))) (rmail-count-new-messages t) (when (rmail-summary-exists) (rmail-select-summary (rmail-update-summary))) - (rmail-count-new-messages t) (rmail-show-message msg)) (save-buffer))))) (kill-buffer tmpbuf))) @@ -1063,8 +1193,7 @@ with potentially long computations." (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))) @@ -1143,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) @@ -1166,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) @@ -1205,6 +1341,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)) @@ -1272,6 +1411,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." @@ -1435,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)) @@ -1521,6 +1661,7 @@ 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) @@ -1538,7 +1679,7 @@ CHOICE is a list of the choice char and help message at IDX." (t (raise-frame frame) (select-frame frame) - (cond ((memq window-system '(x mac)) + (cond ((memq window-system '(x ns mac)) (x-focus-frame frame)) ((eq window-system 'w32) (w32-focus-frame frame))) @@ -1727,7 +1868,30 @@ 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)) + +(defmacro gnus-put-display-table (range value display-table) + "Set the value for char RANGE to VALUE in DISPLAY-TABLE. " + (if (featurep 'xemacs) + (progn + `(if (fboundp 'put-display-table) + (put-display-table ,range ,value ,display-table) + (if (sequencep ,display-table) + (aset ,display-table ,range ,value) + (put-char-table ,range ,value ,display-table)))) + `(aset ,display-table ,range ,value))) + +(defmacro gnus-get-display-table (character display-table) + "Find value for CHARACTER in DISPLAY-TABLE. " + (if (featurep 'xemacs) + `(if (fboundp 'get-display-table) + (get-display-table ,character ,display-table) + (if (sequencep ,display-table) + (aref ,display-table ,character) + (get-char-table ,character ,display-table))) + `(aref ,display-table ,character))) + (provide 'gnus-util) -;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 ;;; gnus-util.el ends here