;; used by Gnus and may be used by any other package without loading
;; Gnus first.
+;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
+;; autoloads below...]
+
;;; Code:
(require 'custom)
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
(defvar nnmail-pathname-coding-system))
-(require 'nnheader)
(require 'time-date)
(require 'netrc)
(autoload 'gnus-get-buffer-window "gnus-win")
(autoload 'rmail-insert-rmail-file-header "rmail")
(autoload 'rmail-count-new-messages "rmail")
- (autoload 'rmail-show-message "rmail"))
+ (autoload 'rmail-show-message "rmail")
+ (autoload 'nnheader-narrow-to-headers "nnheader")
+ (autoload 'nnheader-replace-chars-in-string "nnheader"))
(eval-and-compile
(cond
;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
;; to limit the length of a string. This function is necessary since
;; `(substr "abc" 0 30)' pukes with "Args out of range".
+;; Fixme: Why not `truncate-string-to-width'?
(defsubst gnus-limit-string (str width)
(if (> (length str) width)
(substring str 0 width)
str))
-(defsubst gnus-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))
- (byte-code-function-p form)))
-
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
'point-at-eol
'line-end-position))
+;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
+;; 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
+
(defun gnus-delete-first (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
(if (equal (car list) elt)
(delete-char 1))
(goto-char (next-single-property-change (point) prop nil (point-max))))))
-(require 'nnheader)
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
(let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
:group 'gnus-start
:type 'integer)
-;; Show message if message has a lower level than `gnus-verbose'.
-;; Guideline for numbers:
-;; 1 - error messages, 3 - non-serious error messages, 5 - messages
-;; for things that take a long time, 7 - not very important messages
-;; on stuff, 9 - messages inside loops.
(defun gnus-message (level &rest args)
+ "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
+
+Guideline for numbers:
+1 - error messages, 3 - non-serious error messages, 5 - messages for things
+that take a long time, 7 - not very important messages on stuff, 9 - messages
+inside loops."
(if (<= level gnus-verbose)
(apply 'message args)
;; We have to do this format thingy here even if the result isn't
"Return a composite sort condition based on the functions in FUNC."
(cond
;; Just a simple function.
- ((gnus-functionp funs) funs)
+ ((functionp funs) funs)
;; No functions at all.
((null funs) funs)
;; A list of functions.
(setq function (cadr function)
first 't2
last 't1))
- ((gnus-functionp function)
+ ((functionp function)
;; Do nothing.
)
(t
;;; Functions for saving to babyl/mail files.
-(defvar rmail-default-rmail-file)
+(eval-when-compile
+ (defvar rmail-default-rmail-file)
+ (defvar mm-text-coding-system))
+
(defun gnus-output-to-rmail (filename &optional ask)
"Append the current article to an Rmail file named FILENAME."
(require 'rmail)
+ (require 'mm-util)
;; Most of these codes are borrowed from rmailout.el.
(setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename)
(while (search-backward "\\." nil t)
(delete-char 1)))))
+;; Fixme: Why not use `with-output-to-temp-buffer'?
(defmacro gnus-with-output-to-file (file &rest body)
(let ((buffer (make-symbol "output-buffer"))
(size (make-symbol "output-buffer-size"))
- (leng (make-symbol "output-buffer-length")))
- `(let* ((print-quoted t)
- (print-readably t)
- (print-escape-multibyte nil)
- print-level
- print-length
- (,size 131072)
+ (leng (make-symbol "output-buffer-length"))
+ (append (make-symbol "output-buffer-append")))
+ `(let* ((,size 131072)
(,buffer (make-string ,size 0))
(,leng 0)
- (append nil)
+ (,append nil)
(standard-output
(lambda (c)
- (aset ,buffer ,leng c)
+ (aset ,buffer ,leng c)
+
(if (= ,size (setq ,leng (1+ ,leng)))
- (progn (write-region ,buffer nil ,file append 'no-msg)
+ (progn (write-region ,buffer nil ,file ,append 'no-msg)
(setq ,leng 0
- append t))))))
+ ,append t))))))
,@body
(when (> ,leng 0)
+ (let ((coding-system-for-write 'no-conversion))
(write-region (substring ,buffer 0 ,leng) nil ,file
- append 'no-msg)))))
+ ,append 'no-msg))))))
(put 'gnus-with-output-to-file 'lisp-indent-function 1)
(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
(remove-text-properties start end properties object))
t))
+;; 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.)
(defun gnus-string-equal (x y)
"Like `string-equal', except it compares case-insensitively."
(and (= (length x) (length y))
(string-equal (downcase x) (downcase y)))))
(defcustom gnus-use-byte-compile t
- "If non-nil, byte-compile crucial run-time codes.
-Setting it to nil has no effect after first time running
-`gnus-byte-compile'."
+ "If non-nil, byte-compile crucial run-time code.
+Setting it to nil has no effect after the first time `gnus-byte-compile'
+is run."
:type 'boolean
:version "21.1"
:group 'gnus-various)
(+ 10 (- x ?A)))
(- x ?0)))
+;; Fixme: Do it like QP.
(defun gnus-url-unhex-string (str &optional allow-newlines)
- "Remove %XXX embedded spaces, etc in a url.
+ "Remove %XX, embedded spaces, etc in a url.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding."
- (setq str (or (mm-subst-char-in-string ?+ ? str) ""))
+ (setq str (or (mm-subst-char-in-string ?+ ? str) "")) ; why `or'?
(let ((tmp "")
(case-fold-search t))
(while (string-match "%[0-9a-f][0-9a-f]" str)
(t
(list 'local-map map))))
+(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
+ require-match initial-contents
+ history default)
+ "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
+ `(completing-read ,prompt ,table ,predicate ,require-match
+ ,initial-contents ,history
+ ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
+ ()
+ (list default))))
+
(defun gnus-completing-read (prompt table &optional predicate require-match
history)
(when (and history
(not (boundp history)))
(set history nil))
- (completing-read
+ (gnus-completing-read-maybe-default
(if (symbol-value history)
(concat prompt " (" (car (symbol-value history)) "): ")
(concat prompt ": "))
(while (not tchar)
(message "%s (%s): "
prompt
- (mapconcat (lambda (s) (char-to-string (car s)))
- choice ", "))
+ (concat
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ choice ", ") ", ?"))
(setq tchar (read-char))
(when (not (assq tchar choice))
(setq tchar nil)
display))
display)))))
-(provide 'gnus-util)
-
+;; 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.
If there are several sequences, FUNCTION is called with that many arguments,
(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))))
+
+(provide 'gnus-util)
+
;;; gnus-util.el ends here
projects / gnus / blobdiff