gnus-iswitchb-completing-read)))
(defcustom gnus-completion-styles
- (if (and (boundp 'completion-styles-alist)
- (boundp 'completion-styles))
- (append (when (and (assq 'substring completion-styles-alist)
- (not (memq 'substring completion-styles)))
- (list 'substring))
- completion-styles)
- nil)
+ (append (when (and (assq 'substring completion-styles-alist)
+ (not (memq 'substring completion-styles)))
+ (list 'substring))
+ completion-styles)
"Value of `completion-styles' to use when completing."
:version "24.1"
:group 'gnus-meta
(and (= (car fdate) (car date))
(> (nth 1 fdate) (nth 1 date))))))
-;; Every version of Emacs Gnus supports has built-in float-time.
-;; The featurep test silences an irritating compiler warning.
-(defalias 'gnus-float-time
- (if (or (featurep 'emacs)
- (fboundp 'float-time))
- 'float-time 'time-to-seconds))
-
;;; Keymap macros.
(defmacro gnus-local-set-keys (&rest plist)
(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
(save-restriction
(goto-char beg)
(while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
- (gnus-put-text-property beg (match-beginning 0) prop val)
+ (put-text-property beg (match-beginning 0) prop val)
(setq beg (point)))
- (gnus-put-text-property beg (point) prop val)))))
+ (put-text-property beg (point) prop val)))))
(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."
(when (eq prop 'face)
(setcar (cdr (get-text-property beg 'face)) (or val 'default)))
(inline
- (gnus-put-text-property beg stop prop val)))
+ (put-text-property beg stop prop val)))
(setq beg stop))))
(defun gnus-get-text-property-excluding-characters-with-faces (pos prop)
(apply 'run-hook-with-args hook args)))
(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))))
+ "Run `run-mode-hooks', saving the current buffer."
+ (save-current-buffer (apply 'run-mode-hooks funcs)))
;;; Various
(setq sequence (cdr sequence))))
(nreverse out)))
-(if (fboundp 'assq-delete-all)
- (defalias 'gnus-delete-alist 'assq-delete-all)
- (defun gnus-delete-alist (key alist)
- "Delete from ALIST all elements whose car is KEY.
-Return the modified alist."
- (let (entry)
- (while (setq entry (assq key 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)
(put 'gnus-with-output-to-file 'lisp-indent-function 1)
(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
-(if (fboundp 'union)
- (defalias 'gnus-union 'union)
- (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))))
- (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"
- (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."
+ "Like `add-text-properties', only applied on where PROPERTY is VALUE."
(let (point)
(while (and start
(< start end) ;; XEmacs will loop for every when start=end.
(setq point (text-property-not-all start end property value)))
- (gnus-add-text-properties start point properties object)
+ (add-text-properties start point properties object)
(setq start (text-property-any point end property value)))
(if start
- (gnus-add-text-properties start end properties object))))
+ (add-text-properties start end properties object))))
(defun gnus-remove-text-properties-when
(property value start end properties &optional object)
(setq tchar nil)
(setq buf (get-buffer-create "*Gnus Help*"))
(pop-to-buffer buf)
- (fundamental-mode) ; for Emacs 20.4+
+ (fundamental-mode)
(buffer-disable-undo)
(erase-buffer)
(insert prompt ":\n\n")
(cdr ,result)))
`(mapcar ,function ,seq1)))
-(if (fboundp 'merge)
- (defalias 'gnus-merge 'merge)
- ;; Adapted from cl-seq.el
- (defun gnus-merge (type list1 list2 pred)
- "Destructively merge lists LIST1 and LIST2 to produce a new list.
-Argument TYPE is for compatibility and ignored.
-Ordering of the elements is preserved according to PRED, a `less-than'
-predicate on the elements."
- (let ((res nil))
- (while (and list1 list2)
- (if (funcall pred (car list2) (car list1))
- (push (pop list2) res)
- (push (pop list1) res)))
- (nconc (nreverse res) list1 list2))))
-
(defun gnus-emacs-version ()
"Stringified Emacs version."
(let* ((lst (if (listp gnus-user-agent)
(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))
-
-(defalias 'gnus-read-shell-command
- (if (fboundp 'read-shell-command) 'read-shell-command 'read-string))
-
(declare-function image-size "image.c" (spec &optional pixels frame))
(defun gnus-rescale-image (image size)
image)))
image)))
-(eval-when-compile (require 'gmm-utils))
(defun gnus-recursive-directory-files (dir)
"Return all regular files below DIR.
The first found will be returned if a file has hard or symbolic links."
(let (files attr attrs)
- (gmm-labels
+ (cl-labels
((fn (directory)
(dolist (file (directory-files directory t))
(setq attr (file-attributes (file-truename file)))
(memq elem list))))
found))
-(eval-and-compile
- (cond
- ((fboundp 'match-substitute-replacement)
- (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement))
- (t
- (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp)
- "Return REPLACEMENT as it will be inserted by `replace-match'.
-In other words, all back-references in the form `\\&' and `\\N'
-are substituted with actual strings matched by the last search.
-Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
-meaning as for `replace-match'.
-
-This is the definition of match-substitute-replacement in subr.el from GNU Emacs."
- (let ((match (match-string 0 string)))
- (save-match-data
- (set-match-data (mapcar (lambda (x)
- (if (numberp x)
- (- x (match-beginning 0))
- x))
- (match-data t)))
- (replace-match replacement fixedcase literal match subexp)))))))
-
-(if (fboundp 'string-match-p)
- (defalias 'gnus-string-match-p 'string-match-p)
- (defsubst gnus-string-match-p (regexp string &optional start)
- "\
-Same as `string-match' except this function does not change the match data."
- (save-match-data
- (string-match regexp string start))))
-
-(if (fboundp 'string-prefix-p)
- (defalias 'gnus-string-prefix-p 'string-prefix-p)
- (defun gnus-string-prefix-p (str1 str2 &optional ignore-case)
- "Return non-nil if STR1 is a prefix of STR2.
-If IGNORE-CASE is non-nil, the comparison is done without paying attention
-to case differences."
- (and (<= (length str1) (length str2))
- (let ((prefix (substring str2 0 (length str1))))
- (if ignore-case
- (string-equal (downcase str1) (downcase prefix))
- (string-equal str1 prefix))))))
-
(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;
;;; Image functions.
(defun gnus-image-type-available-p (type)
- (and (fboundp 'image-type-available-p)
- (if (fboundp 'display-images-p)
- (display-images-p)
- t)
+ (and (display-images-p)
(image-type-available-p type)))
(defun gnus-create-image (file &optional type data-p &rest props)