X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=5326b938cf4469dc346eeef668d85e5e4702c8c2;hb=8112a77959fee38576a8b4b3f5f6cb32208d4d03;hp=c2e8991b5f121feafe012717a84a1a3a02d757a9;hpb=173afc58a02260a715d5201ed6cbbb7ba6aca57d;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index c2e8991b5..5326b938c 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -33,7 +33,7 @@ ;;; Code: -;; For Emacs < 22.2. +;; For Emacs <22.2 and XEmacs. (eval-and-compile (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile @@ -44,11 +44,22 @@ (defmacro with-no-warnings (&rest body) `(progn ,@body)))) -(defcustom gnus-use-ido nil - "Whether to use `ido' for `completing-read'." +(defcustom gnus-completing-read-function 'gnus-emacs-completing-read + "Function use to do completing read." :version "24.1" :group 'gnus-meta - :type 'boolean) + :type `(radio (function-item + :doc "Use Emacs standard `completing-read' function." + gnus-emacs-completing-read) + ;; iswitchb.el is very old and ido.el is unavailable + ;; in XEmacs, so we exclude those function items. + ,@(unless (featurep 'xemacs) + '((function-item + :doc "Use `ido-completing-read' function." + gnus-ido-completing-read) + (function-item + :doc "Use iswitchb based completing-read function." + gnus-iswitchb-completing-read))))) (defcustom gnus-completion-styles (if (and (boundp 'completion-styles-alist) @@ -141,11 +152,9 @@ This is a compatibility function for different Emacsen." ;; XEmacs. In Emacs we don't need to call `make-local-hook' first. ;; It's harmless, though, so the main purpose of this alias is to shut ;; up the byte compiler. -(defalias 'gnus-make-local-hook - (if (eq (get 'make-local-hook 'byte-compile) - 'byte-compile-obsolete) - 'ignore ; Emacs - 'make-local-hook)) ; XEmacs +(defalias 'gnus-make-local-hook (if (featurep 'xemacs) + 'make-local-hook + 'ignore)) (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." @@ -1281,6 +1290,11 @@ ARG is passed to the first function." (save-current-buffer (apply 'run-hooks funcs))) +(defun gnus-run-hook-with-args (hook &rest args) + "Does the same as `run-hook-with-args', but saves the current buffer." + (save-current-buffer + (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." @@ -1298,18 +1312,41 @@ This function saves the current buffer." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) -(defun gnus-remove-if (predicate list) - "Return a copy of LIST with all items satisfying PREDICATE removed." +(defun gnus-remove-if (predicate sequence &optional hash-table-p) + "Return a copy of SEQUENCE with all items satisfying PREDICATE removed. +SEQUENCE should be a list, a vector, or a string. Returns always a list. +If HASH-TABLE-P is non-nil, regards SEQUENCE as a hash table." (let (out) - (while list - (unless (funcall predicate (car list)) - (push (car list) out)) - (setq list (cdr list))) + (if hash-table-p + (mapatoms (lambda (symbol) + (unless (funcall predicate symbol) + (push symbol out))) + sequence) + (unless (listp sequence) + (setq sequence (append sequence nil))) + (while sequence + (unless (funcall predicate (car sequence)) + (push (car sequence) out)) + (setq sequence (cdr sequence)))) (nreverse out))) -(defun gnus-remove-if-not (predicate list) - "Return a copy of LIST with all items not satisfying PREDICATE removed." - (gnus-remove-if `(lambda (item) (not (,predicate item))) list)) +(defun gnus-remove-if-not (predicate sequence &optional hash-table-p) + "Return a copy of SEQUENCE with all items not satisfying PREDICATE removed. +SEQUENCE should be a list, a vector, or a string. Returns always a list. +If HASH-TABLE-P is non-nil, regards SEQUENCE as a hash table." + (let (out) + (if hash-table-p + (mapatoms (lambda (symbol) + (when (funcall predicate symbol) + (push symbol out))) + sequence) + (unless (listp sequence) + (setq sequence (append sequence nil))) + (while sequence + (when (funcall predicate (car sequence)) + (push (car sequence) out)) + (setq sequence (cdr sequence)))) + (nreverse out))) (if (fboundp 'assq-delete-all) (defalias 'gnus-delete-alist 'assq-delete-all) @@ -1329,7 +1366,7 @@ Return the modified alist." (when (string-match r word) (throw 'found r)))))) -(defmacro gnus-pull (key alist &optional assoc-p) +(defmacro gnus-alist-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." (unless (symbolp alist) (error "Not a symbol: %s" alist)) @@ -1589,17 +1626,52 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (defun gnus-completing-read (prompt collection &optional require-match initial-input history def) - "Call `completing-read' or `ido-completing-read'. -Depends on `gnus-use-ido'." + "Call `gnus-completing-read-function'." + (funcall gnus-completing-read-function + (concat prompt (when def + (concat " (default " def ")")) + ": ") + collection require-match initial-input history def)) + +(defun gnus-emacs-completing-read (prompt collection &optional require-match + initial-input history def) + "Call standard `completing-read-function'." (let ((completion-styles gnus-completion-styles)) - (funcall - (if gnus-use-ido - 'ido-completing-read - 'completing-read) - (concat prompt (when def - (concat " (default " def ")")) - ": ") - collection nil require-match initial-input history def))) + (completing-read prompt + ;; Old XEmacs (at least 21.4) expect an alist for + ;; collection. + (mapcar 'list collection) + nil require-match initial-input history def))) + +(autoload 'ido-completing-read "ido") +(defun gnus-ido-completing-read (prompt collection &optional require-match + initial-input history def) + "Call `ido-completing-read-function'." + (ido-completing-read prompt collection nil require-match + initial-input history def)) + + +(autoload 'iswitchb-read-buffer "iswitchb") +(defun gnus-iswitchb-completing-read (prompt collection &optional require-match + initial-input history def) + "`iswitchb' based completing-read function." + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist + (let ((choices (append + (when initial-input (list initial-input)) + (symbol-value history) collection)) + filtered-choices) + (dolist (x choices) + (setq filtered-choices (adjoin x filtered-choices))) + (nreverse filtered-choices)))))) + (unwind-protect + (progn + (when (not iswitchb-mode) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (iswitchb-read-buffer prompt def require-match)) + (when (not iswitchb-mode) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) (defun gnus-graphic-display-p () (if (featurep 'xemacs) @@ -1901,6 +1973,26 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" (get-char-table ,character ,display-table))) `(aref ,display-table ,character))) +(defun gnus-rescale-image (image size) + "Rescale IMAGE to SIZE if possible. +SIZE is in format (WIDTH . HEIGHT). Return a new image. +Sizes are in pixels." + (if (or (not (fboundp 'imagemagick-types)) + (not (get-buffer-window (current-buffer)))) + image + (let ((new-width (car size)) + (new-height (cdr size))) + (when (> (cdr (image-size image t)) new-height) + (setq image (or (create-image (plist-get (cdr image) :data) 'imagemagick t + :height new-height) + image))) + (when (> (car (image-size image t)) new-width) + (setq image (or + (create-image (plist-get (cdr image) :data) 'imagemagick t + :width new-width) + image))) + image))) + (provide 'gnus-util) ;;; gnus-util.el ends here