;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
(defvar nnmail-pathname-coding-system)
+ (defvar nnmail-active-file-coding-system)
;; Inappropriate references to other parts of Gnus.
(defvar gnus-emphasize-whitespace-regexp)
+ (defvar gnus-original-article-buffer)
+ (defvar gnus-user-agent)
)
(require 'time-date)
(require 'netrc)
(defalias 'gnus-replace-in-string 'replace-in-string))
((fboundp 'replace-regexp-in-string)
(defun gnus-replace-in-string (string regexp newtext &optional literal)
+ "Replace all matches for REGEXP with NEWTEXT in STRING.
+If LITERAL is non-nil, insert NEWTEXT literally. Return a new
+string containing the replacements.
+
+This is a compatibility function for different Emacsen."
(replace-regexp-in-string regexp newtext string nil literal)))))
(defun gnus-boundp (variable)
(defun gnus-completing-read-with-default (default prompt &rest args)
;; Like `completing-read', except that DEFAULT is the default argument.
(let* ((prompt (if default
- (concat prompt " (default " default ") ")
- (concat prompt " ")))
+ (concat prompt " (default " default "): ")
+ (concat prompt ": ")))
(answer (apply 'completing-read prompt args)))
(if (or (null answer) (zerop (length answer)))
default
(apply 'format args)))
(defun gnus-error (level &rest args)
- "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
+ "Beep an error if LEVEL is equal to or less than `gnus-verbose'.
+ARGS are passed to `message'."
(when (<= (floor level) gnus-verbose)
(apply 'message args)
(ding)
(defun gnus-split-references (references)
"Return a list of Message-IDs in REFERENCES."
(let ((beg 0)
+ (references (or references ""))
ids)
(while (string-match "<[^<]+[^< \t]" references beg)
(push (substring references (match-beginning 0) (setq beg (match-end 0)))
`print-level' to nil. See also `gnus-bind-print-variables'."
(gnus-bind-print-variables (prin1-to-string form)))
-(defun gnus-pp (form)
+(defun gnus-pp (form &optional stream)
"Use `pp' on FORM in the current buffer.
Bind `print-quoted' and `print-readably' to t, and `print-length' and
`print-level' to nil. See also `gnus-bind-print-variables'."
- (gnus-bind-print-variables (pp form (current-buffer))))
+ (gnus-bind-print-variables (pp form (or stream (current-buffer)))))
(defun gnus-pp-to-string (form)
"The same as `pp-to-string'.
(when (file-exists-p file)
(delete-file file)))
+(defun gnus-delete-directory (directory)
+ "Delete files in DIRECTORY. Subdirectories remain.
+If there's no subdirectory, delete DIRECTORY as well."
+ (when (file-directory-p directory)
+ (let ((files (directory-files
+ directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+ file dir)
+ (while files
+ (setq file (pop files))
+ (if (eq t (car (file-attributes file)))
+ ;; `file' is a subdirectory.
+ (setq dir t)
+ ;; `file' is a file or a symlink.
+ (delete-file file)))
+ (unless dir
+ (delete-directory directory)))))
+
(defun gnus-strip-whitespace (string)
"Return STRING stripped of all whitespace."
(while (string-match "[\r\n\t ]+" string)
(save-current-buffer
(apply 'run-hooks funcs)))
+(defun gnus-run-mode-hooks (&rest funcs)
+ "Run `run-mode-hooks' if it is available, otherwise `run-hooks'.
+This function saves the current buffer."
+ (if (fboundp 'run-mode-hooks)
+ (save-current-buffer (apply 'run-mode-hooks funcs))
+ (save-current-buffer (apply 'run-hooks funcs))))
+
;;; Various
(defvar gnus-group-buffer) ; Compiler directive
(set-buffer gnus-group-buffer)
(eq major-mode 'gnus-group-mode))))
-(defun gnus-remove-duplicates (list)
- (let (new)
- (while list
- (or (member (car list) new)
- (setq new (cons (car list) new)))
- (setq list (cdr list)))
- (nreverse new)))
-
(defun gnus-remove-if (predicate list)
"Return a copy of LIST with all items satisfying PREDICATE removed."
(let (out)
(standard-output
(lambda (c)
(aset ,buffer ,leng c)
-
+
(if (= ,size (setq ,leng (1+ ,leng)))
(progn (write-region ,buffer nil ,file ,append 'no-msg)
(setq ,leng 0
Setting it to nil has no effect after the first time `gnus-byte-compile'
is run."
:type 'boolean
- :version "21.4"
+ :version "22.1"
:group 'gnus-various)
(defun gnus-byte-compile (form)
display))
display)))))
+(eval-when-compile
+ (defvar tool-bar-mode))
+
+(defun gnus-tool-bar-update (&rest ignore)
+ "Update the tool bar."
+ (when (and (boundp 'tool-bar-mode)
+ tool-bar-mode)
+ (let* ((args nil)
+ (func (cond ((featurep 'xemacs)
+ 'ignore)
+ ((fboundp 'tool-bar-update)
+ 'tool-bar-update)
+ ((fboundp 'force-window-update)
+ 'force-window-update)
+ ((fboundp 'redraw-frame)
+ (setq args (list (selected-frame)))
+ 'redraw-frame)
+ (t 'ignore))))
+ (apply func args))))
+
;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile.
(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
"Apply FUNCTION to each element of the sequences, and make a list of the results.
(nconc (nreverse res) list1 list2))))
(eval-when-compile
- (defvar xemacs-codename))
+ (defvar xemacs-codename)
+ (defvar sxemacs-codename)
+ (defvar emacs-program-version))
(defun gnus-emacs-version ()
"Stringified Emacs version."
- (let ((system-v
- (cond
- ((eq gnus-user-agent 'emacs-gnus-config)
- system-configuration)
- ((eq gnus-user-agent 'emacs-gnus-type)
- (symbol-name system-type))
- (t nil))))
+ (let* ((lst (if (listp gnus-user-agent)
+ gnus-user-agent
+ '(gnus emacs type)))
+ (system-v (cond ((memq 'config lst)
+ system-configuration)
+ ((memq 'type lst)
+ (symbol-name system-type))
+ (t nil)))
+ codename emacsname)
+ (cond ((featurep 'sxemacs)
+ (setq emacsname "SXEmacs"
+ codename sxemacs-codename))
+ ((featurep 'xemacs)
+ (setq emacsname "XEmacs"
+ codename xemacs-codename))
+ (t
+ (setq emacsname "Emacs")))
(cond
- ((eq gnus-user-agent 'gnus)
+ ((not (memq 'emacs lst))
nil)
((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+ ;; Emacs:
(concat "Emacs/" (match-string 1 emacs-version)
(if system-v
(concat " (" system-v ")")
"")))
- ((string-match
- "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat
- (match-string 1 emacs-version)
- (format "/%d.%d" emacs-major-version emacs-minor-version)
- (if (match-beginning 3)
- (match-string 3 emacs-version)
- "")
- (if (boundp 'xemacs-codename)
- (concat
- " (" xemacs-codename
- (if system-v
- (concat ", " system-v ")")
+ ((or (featurep 'sxemacs) (featurep 'xemacs))
+ ;; XEmacs or SXEmacs:
+ (concat emacsname "/" emacs-program-version
+ " ("
+ (when (and (memq 'codename lst)
+ codename)
+ (concat codename
+ (when system-v ", ")))
+ (when system-v system-v)
")"))
- "")))
(t emacs-version))))
(defun gnus-rename-file (old-path new-path &optional trim)
(setq temp (cdr temp)))
(= (length temp) 0))
(delete-directory old-dir)
- (setq old-dir (file-name-as-directory
- (file-truename
+ (setq old-dir (file-name-as-directory
+ (file-truename
(concat old-dir "..")))))))))
(defun gnus-set-file-modes (filename mode)
(ignore-errors
(set-file-modes filename mode)))
+(if (fboundp 'set-process-query-on-exit-flag)
+ (defalias 'gnus-set-process-query-on-exit-flag
+ 'set-process-query-on-exit-flag)
+ (defalias 'gnus-set-process-query-on-exit-flag
+ 'process-kill-without-query))
+
(provide 'gnus-util)
;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
projects / gnus / blobdiff