Lines Matching +refs:gnus +refs:custom +refs:method
0 ;;; gnus-util.el --- utility functions for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
38 (require 'custom)
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)
78 (defalias 'gnus-replace-in-string 'replace-in-string))
80 (defun gnus-replace-in-string (string regexp newtext &optional literal)
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)
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)
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
163 (defalias 'gnus-make-local-hook
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)
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
260 method group)))
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)))
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)
636 (gnus-byte-compile
638 ,(gnus-make-sort-function-1 (reverse funs)))))
643 (defun gnus-make-sort-function-1 (funs)
663 ,(gnus-make-sort-function-1 (cdr funs))))
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)
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)
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.
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)
1061 (defun gnus-run-hooks (&rest funcs)
1066 (defun gnus-run-mode-hooks (&rest funcs)
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)
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)
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)
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)
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
1665 (provide 'gnus-util)
1668 ;;; gnus-util.el ends here