X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-util.el;h=85de169a7303165d9600425babce822682db67fc;hb=e53007228003522860c20f231785d61d35b7312b;hp=7d5da2269f5fb9ca844b68b550dacb7df4f8a31c;hpb=cc2c1a4888d65e3a2f7d3554c5c71a5ce19c1f0d;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 7d5da2269..85de169a7 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,7 +1,7 @@ ;;; gnus-util.el --- utility functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -74,20 +74,7 @@ string containing the replacements. This is a compatibility function for different Emacsen." (replace-regexp-in-string regexp newtext string nil literal))) ((fboundp 'replace-in-string) - (defalias 'gnus-replace-in-string 'replace-in-string)) - (t - (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." - (let ((start 0) tail) - (while (string-match regexp string start) - (setq tail (- (length string) (match-end 0))) - (setq string (replace-match newtext nil literal string)) - (setq start (- (length string) tail)))) - string)))) + (defalias 'gnus-replace-in-string 'replace-in-string)))) (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." @@ -116,7 +103,7 @@ This is a compatibility function for different Emacsen." (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) (defmacro gnus-intern-safe (string hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." + "Get hash value. Arguments are STRING and HASHTABLE." `(let ((symbol (intern ,string ,hashtable))) (or (boundp symbol) (set symbol nil)) @@ -186,8 +173,13 @@ is slower." ;; First find the address - the thing with the @ in it. This may ;; not be accurate in mail addresses, but does the trick most of ;; the time in news messages. - (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) + (cond (;; Check ``'' first in order to handle the quite common + ;; form ``"abc@xyz" '' (i.e. ``@'' as part of a comment) + ;; correctly. + (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from) + (setq address (substring from (match-beginning 1) (match-end 1)))) + ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) + (setq address (substring from (match-beginning 0) (match-end 0))))) ;; Then we check whether the "name
" format is used. (and address ;; Linear white space is not required. @@ -609,8 +601,10 @@ If N, return the Nth ancestor instead." For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would yield \"nnimap:yxa\"." `(let ((gname ,group)) - (if (string-match "^\\([^+]+\\).\\([^:]+\\):" gname) - (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) + (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname) + (format "%s:%s" (match-string 1 gname) (or + (match-string 2 gname) + "")) (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) (defun gnus-make-sort-function (funs) @@ -1217,6 +1211,13 @@ Return the modified alist." (remove-text-properties start end properties object)) t)) +(defun gnus-string-remove-all-properties (string) + (condition-case () + (let ((s string)) + (set-text-properties 0 (length string) nil string) + s) + (error string))) + ;; This might use `compare-strings' to reduce consing in the ;; case-insensitive case, but it has to cope with null args. ;; (`string-equal' uses symbol print names.) @@ -1577,13 +1578,16 @@ predicate on the elements." ((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) - ")")) + (let (plst) + (when (memq 'codename lst) + (push codename plst)) + (when system-v + (push system-v plst)) + (unless (featurep 'mule) + (push "no MULE" plst)) + (when (> (length plst) 0) + (concat + " (" (mapconcat 'identity (reverse plst) ", ") ")"))))) (t emacs-version)))) (defun gnus-rename-file (old-path new-path &optional trim) @@ -1618,6 +1622,25 @@ empty directories from OLD-PATH." (defalias 'gnus-set-process-query-on-exit-flag 'process-kill-without-query)) +(if (fboundp 'with-local-quit) + (defalias 'gnus-with-local-quit 'with-local-quit) + (defmacro gnus-with-local-quit (&rest body) + "Execute BODY, allowing quits to terminate BODY but not escape further. +When a quit terminates BODY, `gnus-with-local-quit' returns nil but +requests another quit. That quit will be processed as soon as quitting +is allowed once again. (Immediately, if `inhibit-quit' is nil.)" + ;;(declare (debug t) (indent 0)) + `(condition-case nil + (let ((inhibit-quit nil)) + ,@body) + (quit (setq quit-flag t) + ;; This call is to give a chance to handle quit-flag + ;; in case inhibit-quit is nil. + ;; Without this, it will not be handled until the next function + ;; call, and that might allow it to exit thru a condition-case + ;; that intends to handle the quit signal next time. + (eval '(ignore nil)))))) + (provide 'gnus-util) ;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49