X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=31645fcd3154674f230a7ebdf31ed433a5b5bed9;hb=0dbf44d1978501350ac563b8d402411e741eb6f7;hp=526aa7785ca812bb4bfe2907488cb3209993d59a;hpb=fa34413ef06821fe23bb19472096bace0f8b2083;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 526aa7785..31645fcd3 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1,6 +1,6 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996-2014 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -853,10 +853,6 @@ 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 @@ -864,11 +860,9 @@ If there's no subdirectory, delete DIRECTORY as well." (save-restriction (goto-char beg) (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) - (gnus-overlay-put - (gnus-make-overlay beg (match-beginning 0)) - prop val) + (overlay-put (make-overlay beg (match-beginning 0)) prop val) (setq beg (point))) - (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) + (overlay-put (make-overlay beg (point)) prop val))))) (defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val) "The same as `put-text-property', except where `gnus-face' is set. @@ -1378,18 +1372,25 @@ Return the modified alist." (if (fboundp 'union) (defalias 'gnus-union 'union) - (defun gnus-union (l1 l2) - "Set union of lists L1 and L2." + (defun gnus-union (l1 l2 &rest keys) + "Set union of lists L1 and L2. +If KEYS contains the `:test' and `equal' pair, use `equal' to compare +items in lists, otherwise use `eq'." (cond ((null l1) l2) ((null l2) l1) ((equal l1 l2) l1) (t (or (>= (length l1) (length l2)) (setq l1 (prog1 l2 (setq l2 l1)))) - (while l2 - (or (member (car l2) l1) - (push (car l2) l1)) - (pop l2)) + (if (eq 'equal (plist-get keys :test)) + (while l2 + (or (member (car l2) l1) + (push (car l2) l1)) + (pop l2)) + (while l2 + (or (memq (car l2) l1) + (push (car l2) l1)) + (pop l2))) l1)))) (declare-function gnus-add-text-properties "gnus" @@ -1492,7 +1493,7 @@ sure of changing the value of `foo'." (defvar gnus-directory-sep-char-regexp "/" "The regexp of directory separator character. If you find some problem with the directory separator character, try -\"[/\\\\\]\" for some systems.") +\"[/\\\\]\" for some systems.") (defun gnus-url-unhex (x) (if (> x ?9) @@ -1575,8 +1576,10 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional default require-match start matches-set)) + (prompt &optional default require-match + _predicate start matches-set)) (defvar iswitchb-temp-buflist) +(defvar iswitchb-mode) (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) @@ -1978,6 +1981,11 @@ to case differences." (string-equal (downcase str1) (downcase prefix)) (string-equal str1 prefix)))))) +(defalias 'gnus-format-message + (if (fboundp 'format-message) 'format-message + ;; for Emacs < 25, and XEmacs, don't worry about quote translation. + 'format)) + ;; Simple check: can be a macro but this way, although slow, it's really clear. ;; We don't use `bound-and-true-p' because it's not in XEmacs. (defun gnus-bound-and-true-p (sym) @@ -1988,6 +1996,31 @@ to case differences." (defun gnus-timer--function (timer) (elt timer 5))) +(defun gnus-test-list (list predicate) + "To each element of LIST apply PREDICATE. +Return nil if LIST is no list or is empty or some test returns nil; +otherwise, return t." + (when (and list (listp list)) + (let ((result (mapcar predicate list))) + (not (memq nil result))))) + +(defun gnus-subsetp (list1 list2) + "Return t if LIST1 is a subset of LIST2. +Similar to `subsetp' but use member for element test so that this works for +lists of strings." + (when (and (listp list1) (listp list2)) + (if list1 + (and (member (car list1) list2) + (gnus-subsetp (cdr list1) list2)) + t))) + +(defun gnus-setdiff (list1 list2) + "Return member-based set difference of LIST1 and LIST2." + (when (and list1 (listp list1) (listp list2)) + (if (member (car list1) list2) + (gnus-setdiff (cdr list1) list2) + (cons (car list1) (gnus-setdiff (cdr list1) list2))))) + (provide 'gnus-util) ;;; gnus-util.el ends here