Lines Matching +defs:gnus +defs:make +defs:sort +defs:function
0 ;;; gnus-util.el --- utility functions for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
41 ;; Fixme: this should be a gnus variable, not nnmail-.
46 (defvar gnus-emphasize-whitespace-regexp)
47 (defvar gnus-original-article-buffer)
48 (defvar gnus-user-agent)
55 (autoload 'gnus-get-buffer-window "gnus-win")
70 (defun gnus-replace-in-string (string regexp newtext &optional literal)
75 This is a compatibility function for different Emacsen."
78 (defalias 'gnus-replace-in-string 'replace-in-string))
80 (defun gnus-replace-in-string (string regexp newtext &optional literal)
85 This is a compatibility function for different Emacsen."
94 (defalias 'gnus-netrc-get 'netrc-get)
95 (defalias 'gnus-netrc-machine 'netrc-machine)
96 (defalias 'gnus-parse-netrc 'netrc-parse)
98 (defun gnus-boundp (variable)
103 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
105 (let ((tempvar (make-symbol "GnusStartBufferWindow"))
106 (w (make-symbol "w"))
107 (buf (make-symbol "buf")))
110 (,w (gnus-get-buffer-window ,buf 'visible)))
121 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
122 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
124 (defmacro gnus-intern-safe (string hashtable)
132 ;; to limit the length of a string. This function is necessary since
135 (defsubst gnus-limit-string (str width)
140 (defsubst gnus-goto-char (point)
143 (defmacro gnus-buffer-exists-p (buffer)
149 (defalias 'gnus-point-at-bol
154 (defalias 'gnus-point-at-eol
160 ;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
163 (defalias 'gnus-make-local-hook
164 (if (eq (get 'make-local-hook 'byte-compile)
167 'make-local-hook)) ; XEmacs
169 (defun gnus-delete-first (elt list)
182 (defmacro gnus-delete-line (&optional n)
183 `(delete-region (gnus-point-at-bol)
186 (defun gnus-byte-code (func)
188 (let ((fval (indirect-function func)))
189 (if (byte-code-function-p fval)
195 (defun gnus-extract-address-components (from)
234 (defun gnus-fetch-field (field)
243 (defun gnus-fetch-original-field (field)
245 (with-current-buffer gnus-original-article-buffer
246 (gnus-fetch-field field)))
249 (defun gnus-goto-colon ()
251 (let ((eol (gnus-point-at-eol)))
252 (goto-char (or (text-property-any (point) eol 'gnus-position t)
256 (defun gnus-decode-newsgroups (newsgroups group &optional method)
257 (let ((method (or method (gnus-find-method-for-group group))))
259 (gnus-group-name-decode group (gnus-group-name-charset
264 (defun gnus-remove-text-with-property (prop)
273 (defun gnus-newsgroup-directory-form (newsgroup)
275 (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
284 (defun gnus-newsgroup-savable-name (group)
289 (defun gnus-string> (s1 s2)
295 (defun gnus-file-newer-than (file date)
303 (defmacro gnus-local-set-keys (&rest plist)
305 `(gnus-define-keys-1 (current-local-map) ',plist))
307 (defmacro gnus-define-keys (keymap &rest plist)
309 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
311 (defmacro gnus-define-keys-safe (keymap &rest plist)
313 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
315 (put 'gnus-define-keys 'lisp-indent-function 1)
316 (put 'gnus-define-keys-safe 'lisp-indent-function 1)
317 (put 'gnus-local-set-keys 'lisp-indent-function 1)
319 (defmacro gnus-define-keymap (keymap &rest plist)
321 `(gnus-define-keys-1 ,keymap (quote ,plist)))
323 (put 'gnus-define-keymap 'lisp-indent-function 1)
325 (defun gnus-define-keys-1 (keymap plist &optional safe)
345 (defun gnus-completing-read-with-default (default prompt &rest args)
357 (defun gnus-y-or-n-p (prompt)
362 (defun gnus-yes-or-no-p (prompt)
372 (defun gnus-seconds-today ()
377 (defun gnus-seconds-month ()
383 (defun gnus-seconds-year ()
390 (defvar gnus-user-date-format-alist
391 '(((gnus-seconds-today) . "%k:%M")
393 ((gnus-seconds-month) . "%a %d")
394 ((gnus-seconds-year) . "%b %d")
409 You can use the functions `gnus-seconds-today', `gnus-seconds-month'
410 and `gnus-seconds-year' in the AGE spec. They return the number of
414 (defun gnus-user-date (messy-date)
415 "Format the messy-date according to gnus-user-date-format-alist.
424 (templist gnus-user-date-format-alist)
435 (defun gnus-dd-mmm (messy-date)
441 (defmacro gnus-date-get-time (date)
448 (or (get-text-property 0 'gnus-time d)
452 (put-text-property 0 1 'gnus-time time d)
455 (defsubst gnus-time-iso8601 (time)
459 (defun gnus-date-iso8601 (date)
462 (gnus-time-iso8601 (gnus-date-get-time date))
465 (defun gnus-mode-string-quote (string)
467 (gnus-replace-in-string string "%" "%%"))
471 (defun gnus-make-hashtable (&optional hashsize)
472 (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0))
480 (defun gnus-create-hash-size (min)
486 (defcustom gnus-verbose 7
492 :group 'gnus-start
495 (defun gnus-message (level &rest args)
496 "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
502 (if (<= level gnus-verbose)
509 (defun gnus-error (level &rest args)
510 "Beep an error if LEVEL is equal to or less than `gnus-verbose'.
512 (when (<= (floor level) gnus-verbose)
521 (defun gnus-split-references (references)
530 (defsubst gnus-parent-id (references &optional n)
536 (let ((ids (inline (gnus-split-references references))))
543 (defun gnus-buffer-live-p (buffer)
549 (defun gnus-horizontal-recenter ()
552 (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)
554 (end (window-end (gnus-get-buffer-window (current-buffer) t)))
565 ;; Scroll horizontally to center (sort of) the point.
568 (gnus-get-buffer-window (current-buffer) t)
571 (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0))
574 (defun gnus-read-event-char (&optional prompt)
577 ;; should be gnus-characterp, but this can't be called in XEmacs anyway
580 (defun gnus-sortable-date (date)
582 (gnus-time-iso8601 (date-to-time date)))
584 (defun gnus-copy-file (file &optional to)
596 (defvar gnus-work-buffer " *gnus work*")
598 (defun gnus-set-work-buffer ()
600 (if (get-buffer gnus-work-buffer)
602 (set-buffer gnus-work-buffer)
604 (set-buffer (gnus-get-buffer-create gnus-work-buffer))
608 (defmacro gnus-group-real-name (group)
615 (defmacro gnus-group-server (group)
617 For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would
624 (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
626 (defun gnus-make-sort-function (funs)
627 "Return a composite sort condition based on the functions in FUNS."
629 ;; Just a simple function.
636 (gnus-byte-compile
638 ,(gnus-make-sort-function-1 (reverse funs)))))
639 ;; A list containing just one function.
643 (defun gnus-make-sort-function-1 (funs)
644 "Return a composite sort condition based on the functions in FUNS."
645 (let ((function (car funs))
648 (when (consp function)
651 ((eq (car function) 'not)
652 (setq function (cadr function)
655 ((functionp function)
659 (error "Invalid sort spec: %s" function))))
661 `(or (,function ,first ,last)
662 (and (not (,function ,last ,first))
663 ,(gnus-make-sort-function-1 (cdr funs))))
664 `(,function ,first ,last))))
666 (defun gnus-turn-off-edit-menu (type)
667 "Turn off edit menu in `gnus-TYPE-mode-map'."
668 (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
671 (defmacro gnus-bind-print-variables (&rest forms)
691 (defun gnus-prin1 (form)
694 `print-level' to nil. See also `gnus-bind-print-variables'."
695 (gnus-bind-print-variables (prin1 form (current-buffer))))
697 (defun gnus-prin1-to-string (form)
700 `print-level' to nil. See also `gnus-bind-print-variables'."
701 (gnus-bind-print-variables (prin1-to-string form)))
703 (defun gnus-pp (form)
706 `print-level' to nil. See also `gnus-bind-print-variables'."
707 (gnus-bind-print-variables (pp form (current-buffer))))
709 (defun gnus-pp-to-string (form)
712 `print-level' to nil. See also `gnus-bind-print-variables'."
713 (gnus-bind-print-variables (pp-to-string form)))
715 (defun gnus-make-directory (directory)
721 (make-directory directory t)))
724 (defun gnus-write-buffer (file)
727 (gnus-make-directory (file-name-directory file))
732 (defun gnus-delete-file (file)
737 (defun gnus-delete-directory (directory)
754 ;; The following two functions are used in gnus-registry.
756 (defun gnus-alist-to-hashtable (alist)
758 (let ((ht (make-hash-table
767 (defun gnus-hashtable-to-alist (hash)
776 (defun gnus-strip-whitespace (string)
782 (defsubst gnus-put-text-property-excluding-newlines (beg end prop val)
788 (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
789 (gnus-put-text-property beg (match-beginning 0) prop val)
791 (gnus-put-text-property beg (point) prop val)))))
793 (defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
799 (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
800 (gnus-overlay-put
801 (gnus-make-overlay beg (match-beginning 0))
804 (gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
806 (defun gnus-put-text-property-excluding-characters-with-faces (beg end
808 "The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
811 (when (get-text-property b 'gnus-face)
812 (setq b (next-single-property-change b 'gnus-face nil end)))
815 (gnus-put-text-property
816 b (setq b (next-single-property-change b 'gnus-face nil end))
819 (defmacro gnus-faces-at (position)
838 (defvar gnus-atomic-be-safe t
841 (defmacro gnus-atomic-progn (&rest forms)
849 `(let ((inhibit-quit gnus-atomic-be-safe))
852 (put 'gnus-atomic-progn 'lisp-indent-function 0)
854 (defmacro gnus-atomic-progn-assign (protect &rest forms)
858 It is safe to use gnus-atomic-progn-assign with long computations.
863 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
877 (result (make-symbol "result-tmp")))
883 (let ((inhibit-quit gnus-atomic-be-safe))
887 (put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
888 ;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
890 (defmacro gnus-atomic-setq (&rest pairs)
894 see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
901 `(gnus-atomic-progn-assign ,syms
904 ;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
930 (defun gnus-output-to-rmail (filename &optional ask)
943 (gnus-yes-or-no-p
951 (gnus-write-buffer filename)))
957 (gnus-convert-article-to-rmail)
987 (defun gnus-output-to-mail (filename &optional ask)
997 (gnus-y-or-n-p
1004 (gnus-write-buffer filename)))
1043 (defun gnus-convert-article-to-rmail ()
1054 (defun gnus-map-function (funs arg)
1055 "Apply the result of the first function in FUNS to the second, and so on.
1056 ARG is passed to the first function."
1061 (defun gnus-run-hooks (&rest funcs)
1066 (defun gnus-run-mode-hooks (&rest funcs)
1068 This function saves the current buffer."
1075 (defvar gnus-group-buffer) ; Compiler directive
1076 (defun gnus-alive-p ()
1078 (and (boundp 'gnus-group-buffer)
1079 (get-buffer gnus-group-buffer)
1081 (set-buffer gnus-group-buffer)
1082 (eq major-mode 'gnus-group-mode))))
1084 (defun gnus-remove-if (predicate list)
1094 (defalias 'gnus-delete-alist 'assq-delete-all)
1095 (defun gnus-delete-alist (key alist)
1103 (defmacro gnus-pull (key alist &optional assoc-p)
1110 (defun gnus-globalify-regexp (re)
1116 (defun gnus-set-window-start (&optional point)
1118 (let ((win (gnus-get-buffer-window (current-buffer) t)))
1122 (defun gnus-annotation-in-region-p (b e)
1124 (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
1125 (text-property-any b e 'gnus-undeletable t)))
1127 (defun gnus-or (&rest elems)
1134 (defun gnus-and (&rest elems)
1142 (defun gnus-write-active-file (file hashtb &optional full-names)
1153 (intern (gnus-group-real-name (symbol-name sym))))
1163 (defmacro gnus-with-output-to-file (file &rest body)
1164 (let ((buffer (make-symbol "output-buffer"))
1165 (size (make-symbol "output-buffer-size"))
1166 (leng (make-symbol "output-buffer-length"))
1167 (append (make-symbol "output-buffer-append")))
1169 (,buffer (make-string ,size 0))
1186 (put 'gnus-with-output-to-file 'lisp-indent-function 1)
1187 (put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
1190 (defalias 'gnus-union 'union)
1191 (defun gnus-union (l1 l2)
1205 (defun gnus-add-text-properties-when
1207 "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
1212 (gnus-add-text-properties start point properties object)
1215 (gnus-add-text-properties start end properties object))))
1217 (defun gnus-remove-text-properties-when
1233 (defun gnus-string-equal (x y)
1239 (defcustom gnus-use-byte-compile t
1241 Setting it to nil has no effect after the first time `gnus-byte-compile'
1245 :group 'gnus-various)
1247 (defun gnus-byte-compile (form)
1248 "Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
1249 (if gnus-use-byte-compile
1256 (defalias 'gnus-byte-compile
1260 (gnus-byte-compile form))
1263 (defun gnus-remassoc (key alist)
1267 by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be
1272 (setcdr alist (gnus-remassoc key (cdr alist)))
1275 (defun gnus-update-alist-soft (key value alist)
1277 (cons (cons key value) (gnus-remassoc key alist))
1278 (gnus-remassoc key alist)))
1280 (defun gnus-create-info-command (node)
1286 (setq gnus-info-buffer (current-buffer))
1287 (gnus-configure-windows 'info)))
1289 (defun gnus-not-ignore (&rest args)
1292 (defvar gnus-directory-sep-char-regexp "/"
1297 (defun gnus-url-unhex (x)
1305 (defun gnus-url-unhex-string (str &optional allow-newlines)
1314 (ch1 (gnus-url-unhex (elt str (+ start 1))))
1316 (gnus-url-unhex (elt str (+ start 2))))))
1329 (defun gnus-make-predicate (spec)
1330 "Transform SPEC into a function that can be called.
1333 `(lambda (elem) ,(gnus-make-predicate-1 spec)))
1335 (defun gnus-make-predicate-1 (spec)
1341 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
1344 (defun gnus-local-map-property (map)
1354 (defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
1364 (defun gnus-completing-read (prompt table &optional predicate require-match
1369 (gnus-completing-read-maybe-default
1380 (defun gnus-graphic-display-p ()
1387 (put 'gnus-parse-without-error 'lisp-indent-function 0)
1388 (put 'gnus-parse-without-error 'edebug-form-spec '(body))
1390 (defmacro gnus-parse-without-error (&rest body)
1398 (gnus-error 4 "Invalid data on line %d"
1402 (defun gnus-cache-file-contents (file variable function)
1410 (setq contents (funcall function file))
1415 (defun gnus-multiple-choice (prompt choice &optional idx)
1467 (defun gnus-select-frame-set-input-focus (frame)
1489 (defun gnus-frame-or-window-display-name (object)
1507 (defun gnus-tool-bar-update (&rest ignore)
1524 ;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile.
1525 (defmacro gnus-mapcar (function seq1 &rest seqs2_n)
1526 "Apply FUNCTION to each element of the sequences, and make a list of the results.
1530 `mapcar' function extended to arbitrary sequence types."
1536 (make-symbol (concat "head"
1540 (result (make-symbol "result"))
1541 (result-tail (make-symbol "result-tail")))
1550 (setcdr ,result-tail (cons (funcall ,function
1557 `(mapcar ,function ,seq1)))
1560 (defalias 'gnus-merge 'merge)
1562 (defun gnus-merge (type list1 list2 pred)
1579 (defun gnus-emacs-version ()
1581 (let* ((lst (if (listp gnus-user-agent)
1582 gnus-user-agent
1583 '(gnus emacs type)))
1619 (defun gnus-rename-file (old-path new-path &optional trim)
1628 (gnus-make-directory new-dir)
1641 (defalias 'gnus-set-process-query-on-exit-flag
1643 (defalias 'gnus-set-process-query-on-exit-flag
1647 (defalias 'gnus-with-local-quit 'with-local-quit)
1648 (defmacro gnus-with-local-quit (&rest body)
1650 When a quit terminates BODY, `gnus-with-local-quit' returns nil but
1660 ;; Without this, it will not be handled until the next function
1665 (provide 'gnus-util)
1668 ;;; gnus-util.el ends here