Lines Matching +defs:gnus +defs:or
0 ;;; gnus-spec.el --- format spec functions for Gnus
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
31 (defvar gnus-newsrc-file-version)
33 (require 'gnus)
35 (defcustom gnus-use-correct-string-widths (featurep 'xemacs)
38 :group 'gnus-format
41 (defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
45 :group 'gnus-format
50 (defvar gnus-summary-mark-positions nil)
51 (defvar gnus-group-mark-positions nil)
52 (defvar gnus-group-indentation "")
63 (defvar gnus-tmp-unread)
64 (defvar gnus-tmp-replied)
65 (defvar gnus-tmp-score-char)
66 (defvar gnus-tmp-indentation)
67 (defvar gnus-tmp-opening-bracket)
68 (defvar gnus-tmp-lines)
69 (defvar gnus-tmp-name)
70 (defvar gnus-tmp-closing-bracket)
71 (defvar gnus-tmp-subject-or-nil)
72 (defvar gnus-tmp-subject)
73 (defvar gnus-tmp-marked)
74 (defvar gnus-tmp-marked-mark)
75 (defvar gnus-tmp-subscribed)
76 (defvar gnus-tmp-process-marked)
77 (defvar gnus-tmp-number-of-unread)
78 (defvar gnus-tmp-group-name)
79 (defvar gnus-tmp-group)
80 (defvar gnus-tmp-article-number)
81 (defvar gnus-tmp-unread-and-unselected)
82 (defvar gnus-tmp-news-method)
83 (defvar gnus-tmp-news-server)
84 (defvar gnus-tmp-article-number)
85 (defvar gnus-mouse-face)
86 (defvar gnus-mouse-face-prop)
87 (defvar gnus-tmp-header)
88 (defvar gnus-tmp-from)
90 (defun gnus-summary-line-format-spec ()
91 (insert gnus-tmp-unread gnus-tmp-replied
92 gnus-tmp-score-char gnus-tmp-indentation)
93 (gnus-put-text-property
97 (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
100 (gnus-summary-from-or-to-or-newsgroups
101 gnus-tmp-header gnus-tmp-from))))
105 gnus-tmp-closing-bracket))
107 gnus-mouse-face-prop gnus-mouse-face)
108 (insert " " gnus-tmp-subject-or-nil "\n"))
110 (defvar gnus-summary-line-format-spec
111 (gnus-byte-code 'gnus-summary-line-format-spec))
113 (defun gnus-summary-dummy-line-format-spec ()
115 (gnus-put-text-property
120 gnus-mouse-face-prop gnus-mouse-face)
121 (insert " " gnus-tmp-subject "\n"))
123 (defvar gnus-summary-dummy-line-format-spec
124 (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
126 (defun gnus-group-line-format-spec ()
127 (insert gnus-tmp-marked-mark gnus-tmp-subscribed
128 gnus-tmp-process-marked
129 gnus-group-indentation
130 (format "%5s: " gnus-tmp-number-of-unread))
131 (gnus-put-text-property
134 (insert gnus-tmp-group "\n")
136 gnus-mouse-face-prop gnus-mouse-face))
137 (defvar gnus-group-line-format-spec
138 (gnus-byte-code 'gnus-group-line-format-spec))
140 (defvar gnus-format-specs
142 (gnus-version . ,(gnus-continuum-version))
143 (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
145 ,gnus-summary-dummy-line-format-spec)
147 ,gnus-summary-line-format-spec))
150 (defvar gnus-default-format-specs gnus-format-specs)
152 (defvar gnus-article-mode-line-format-spec nil)
153 (defvar gnus-summary-mode-line-format-spec nil)
154 (defvar gnus-group-mode-line-format-spec nil)
159 (defun gnus-update-format (var)
168 (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
170 (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
172 (entry (assq type gnus-format-specs))
175 (setq gnus-format-specs (delq entry gnus-format-specs)))
178 (gnus-parse-format (setq value (symbol-value (intern var)))
182 (push (list type value spec) gnus-format-specs)
187 (insert (gnus-pp-to-string spec))))
189 (defun gnus-update-format-specifications (&optional force &rest types)
194 (when (or force
195 (not gnus-newsrc-file-version)
196 (not (equal (gnus-continuum-version)
197 (gnus-continuum-version gnus-newsrc-file-version)))
199 (cdr (assq 'version gnus-format-specs)))))
200 (setq gnus-format-specs nil))
204 (let ((spec (assq 'group gnus-format-specs)))
205 (unless (string-match " gnus-tmp-decoded-group[ )]"
206 (gnus-prin1-to-string (nth 2 spec)))
207 (setq gnus-format-specs (delq spec gnus-format-specs)))))
215 (let ((buffer (intern (format "gnus-%s-buffer" type))))
218 (gnus-buffer-exists-p val))
221 (intern (format "gnus-%s-line-format" type)))))
222 (setq entry (cdr (assq type gnus-format-specs)))
226 (set (intern (format "gnus-%s-line-format-spec" type))
231 ;; This is a function call or something.
234 (gnus-parse-format
237 (intern (format "gnus-%s-line-format-alist" type)))
244 (push (list type new-format val) gnus-format-specs))
245 (set (intern (format "gnus-%s-line-format-spec" type)) val)
248 (unless (assq 'version gnus-format-specs)
249 (push (cons 'version emacs-version) gnus-format-specs))
252 (defvar gnus-mouse-face-0 'highlight)
253 (defvar gnus-mouse-face-1 'highlight)
254 (defvar gnus-mouse-face-2 'highlight)
255 (defvar gnus-mouse-face-3 'highlight)
256 (defvar gnus-mouse-face-4 'highlight)
258 (defun gnus-mouse-face-function (form type)
259 `(gnus-put-text-property
261 gnus-mouse-face-prop
263 'gnus-mouse-face
264 `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
266 (defvar gnus-face-0 'bold)
267 (defvar gnus-face-1 'italic)
268 (defvar gnus-face-2 'bold-italic)
269 (defvar gnus-face-3 'bold)
270 (defvar gnus-face-4 'bold)
272 (defun gnus-face-face-function (form type)
273 `(gnus-add-text-properties
275 '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type))))))
277 (defun gnus-balloon-face-function (form type)
278 `(gnus-put-text-property
283 ,(intern (format "gnus-balloon-face-%d" type))))
285 (defun gnus-spec-tab (column)
297 (defun gnus-correct-length (string)
300 (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
303 (defun gnus-correct-substring (string start &optional end)
313 (incf wseek (gnus-char-width (aref string seek)))
318 (or (not end)
320 (incf wseek (gnus-char-width (aref string seek)))
325 (defun gnus-string-width-function ()
327 (gnus-use-correct-string-widths
328 'gnus-correct-length)
334 (defun gnus-substring-function ()
336 (gnus-use-correct-string-widths
337 'gnus-correct-substring)
339 'gnus-correct-substring)
343 (defun gnus-tilde-max-form (el max-width)
346 (length-fun (gnus-string-width-function))
347 (substring-fun (gnus-substring-function)))
361 (defun gnus-tilde-cut-form (el cut-width)
364 (length-fun (gnus-string-width-function))
365 (substring-fun (gnus-substring-function)))
379 (defun gnus-tilde-ignore-form (el ignore-value)
388 (defun gnus-pad-form (el pad-width)
390 characters correctly. This is because `format' may pad to columns or to
394 (length-fun (gnus-string-width-function)))
410 (defun gnus-parse-format (format spec-alist &optional insert)
421 (gnus-parse-complex-format format spec-alist)
423 (gnus-parse-simple-format format spec-alist insert))))
425 (defun gnus-parse-complex-format (format spec-alist)
428 (gnus-set-work-buffer)
440 (if (or (= delim ?\()
466 `(let (gnus-position)
467 ,@(gnus-complex-form-to-spec form spec-alist)
468 (if gnus-position
469 (gnus-put-text-property gnus-position (1+ gnus-position)
470 'gnus-position t)))
472 ,@(gnus-complex-form-to-spec form spec-alist)))))))
474 (defun gnus-complex-form-to-spec (form spec-alist)
480 (gnus-parse-simple-format sform spec-alist t))
482 '(setq gnus-position (point)))
484 (gnus-spec-tab (cadr sform)))
486 (funcall (intern (format "gnus-%s-face-function" (car sform)))
487 (gnus-complex-form-to-spec (cddr sform) spec-alist)
492 (defun gnus-xmas-format (fstring &rest args)
514 (let* ((minlen (string-to-number (or (match-string 2) "")))
526 (defun gnus-parse-simple-format (format spec-alist &optional insert)
535 (gnus-set-work-buffer)
618 "gnus-user-format-function-%s"
619 "gnus-user-format-function-%c")
621 'gnus-tmp-header)
624 ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
631 gnus-use-correct-string-widths)))
634 (if (or max-width cut-width ignore-value
636 gnus-use-correct-string-widths))
645 (setq el (gnus-tilde-ignore-form el ignore-value)))
647 (setq el (gnus-tilde-cut-form el cut-width)))
649 (setq el (gnus-tilde-max-form el max-width)))
651 (setq el (gnus-pad-form el pad-width)))
693 gnus-make-format-preserve-properties
697 (list (cons 'gnus-xmas-format (cons fstring (nreverse flist)))))
713 (defun gnus-eval-format (format &optional alist props)
716 (let ((form (gnus-parse-format format alist props)))
718 (gnus-add-text-properties (point) (progn (eval form) (point)) props)
721 (defun gnus-compile ()
725 (let ((entries gnus-format-specs)
727 entry gnus-tmp-func)
729 (gnus-message 7 "Compiling format specs...")
733 (if (memq (car entry) '(gnus-version version))
734 (setq gnus-format-specs (delq entry gnus-format-specs))
742 (defalias 'gnus-tmp-func `(lambda () ,form))
743 (byte-compile 'gnus-tmp-func)
744 (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
746 (push (cons 'version emacs-version) gnus-format-specs)
748 (gnus-dribble-touch)
749 (gnus-message 7 "Compiling user specs...done"))))
751 (defun gnus-set-format (type &optional insertable)
752 (set (intern (format "gnus-%s-line-format-spec" type))
753 (gnus-parse-format
754 (symbol-value (intern (format "gnus-%s-line-format" type)))
755 (symbol-value (intern (format "gnus-%s-line-format-alist" type)))
758 (provide 'gnus-spec)
765 ;;; gnus-spec.el ends here