;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
`(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
;; This is how URLs _should_ be embedded in text...
- ("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
+ ("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
;; Next regexp stolen from highlight-headers.el.
;; Modified by Vladimir Alexiev.
(,gnus-button-url-regexp 0 t gnus-button-url 0)
;(eval-when-compile
; (defvar browse-url-browser-function))
+;;; Group mode highlighting.
+
+(defvar gnus-group-highlight
+ (cond
+ ((not (eq gnus-display-type 'color))
+ '((mailp . bold)
+ ((= unread 0) . italic)))
+ ((eq gnus-background-mode 'dark)
+ `(((> unread 200) . ,(custom-face-lookup "Red" nil nil t nil nil))
+ ((and (< level 3) (zerop unread)) .
+ ,(custom-face-lookup "SeaGreen" nil nil t nil nil))
+ ((< level 3) . ,(custom-face-lookup "SpringGreen" nil nil t nil nil))
+ ((zerop unread) . ,(custom-face-lookup "SteelBlue" nil nil t nil nil))
+ (t . ,(custom-face-lookup "SkyBlue" nil nil t nil nil))
+ ))
+ (t
+ `(((not mailp) .
+ ,(custom-face-lookup "ForestGreen" nil nil t nil nil))
+ ((zerop unread) .
+ ,(custom-face-lookup "Blue" nil nil t nil nil)))))
+ "Group lines are highlighted with the FACE for the first FORM which
+evaluate to a non-nil value.
+
+Point will be at the beginning of the line when FORM is evaluated.
+Variables bound when these forms are evaluated include:
+
+group: The group name.
+unread: The number of unread articles.
+method: The select method.
+mailp: Whether the select method is a mail method.
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles in the group.
+")
+
+
;;; Internal variables.
(defvar gnus-button-marker-list nil)
["Unmark all" gnus-group-unmark-all-groups t]
["Mark regexp" gnus-group-mark-regexp t]
["Mark region" gnus-group-mark-region t]
+ ["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument t])
("Subscribe"
["Subscribe to random group" gnus-group-unsubscribe-group t]
["Set mark" gnus-summary-mark-as-processable t]
["Remove mark" gnus-summary-unmark-as-processable t]
["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
["Mark series" gnus-uu-mark-series t]
["Mark region" gnus-uu-mark-region t]
["Mark by regexp" gnus-uu-mark-by-regexp t]
:selected (null gnus-score-default-header)]
["From" (gnus-score-set-default 'gnus-score-default-header 'a)
:style radio
- :selected (eq gnus-score-default-header 'a )]
+ :selected (eq gnus-score-default-header 'a)]
["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
:style radio
- :selected (eq gnus-score-default-header 's )]
+ :selected (eq gnus-score-default-header 's)]
["Article body"
(gnus-score-set-default 'gnus-score-default-header 'b)
:style radio
;; It is the message that forces the active status to be updated.
(message ""))
-(defvar gnus-score-default-header nil
- "Default header when entering new scores.
-
-Should be one of the following symbols.
-
- a: from
- s: subject
- b: body
- h: head
- i: message-id
- t: references
- x: xref
- l: lines
- d: date
- f: followup
-
-If nil, the user will be asked for a header.")
-
-(defvar gnus-score-default-type nil
- "Default match type when entering new scores.
-
-Should be one of the following symbols.
-
- s: substring
- e: exact string
- f: fuzzy string
- r: regexp string
- b: before date
- a: at date
- n: this date
- <: less than number
- >: greater than number
- =: equal to number
-
-If nil, the user will be asked for a match type.")
-
-(defvar gnus-score-default-fold nil
- "Use case folding for new score file entries iff not nil.")
-
-
-(defun gnus-score-default-fold-toggle ()
- "Toggle folding for new score file entries."
- (interactive)
- (setq gnus-score-default-fold (not gnus-score-default-fold))
- (if gnus-score-default-fold
- (message "New score file entries will be case insensitive.")
- (message "New score file entries will be case sensitive.")))
-
-(defvar gnus-score-default-duration nil
- "Default duration of effect when entering new scores.
-
-Should be one of the following symbols.
-
- t: temporary
- p: permanent
- i: immediate
-
-If nil, the user will be asked for a duration.")
-
(defun gnus-visual-score-map (type)
(if t
nil
(funcall gnus-summary-highlight-line-function article face))))
(goto-char p)))
+(defun gnus-group-highlight-line ()
+ "Highlight the current line according to `gnus-group-highlight'."
+ (let* ((list gnus-group-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (group (gnus-group-group-name))
+ (entry (gnus-group-entry group))
+ (unread (if (numberp (car entry)) (car entry) 0))
+ (info (nth 2 entry))
+ (method (gnus-server-get-method group (gnus-info-method info)))
+ (marked (gnus-info-marks info))
+ (mailp (memq 'mail (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ (level (gnus-info-level info))
+ (score (gnus-info-score info))
+ (ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (gnus-extent-start-open beg)))
+ (goto-char p)))
+
;;;
;;; gnus-carpal
;;;
(setq button (car buttons)
buttons (cdr buttons))
(if (stringp button)
- (set-text-properties
+ (gnus-set-text-properties
(point)
(prog2 (insert button) (point) (insert " "))
(list 'face gnus-carpal-header-face))
- (set-text-properties
+ (gnus-set-text-properties
(point)
(prog2 (insert (car button)) (point) (insert " "))
(list 'gnus-callback (cdr button)
(when (get-text-property (point) 'gnus-callback)
(goto-char (funcall function (point) 'gnus-callback nil limit)))
;; Go to the next (or previous) button.
- (funcall function (point) 'gnus-callback nil limit)
+ (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
(decf n))
(unless (zerop n)
(gnus-message 5 "No more buttons"))
(save-excursion
(set-buffer gnus-article-buffer)
(save-restriction
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (narrow-to-region (1- (point)) (point-min))
- (let ((alist gnus-header-face-alist)
- (buffer-read-only nil)
- (case-fold-search t)
- (inhibit-point-motion-hooks t)
- entry regexp header-face field-face from hpoints fpoints)
+ (let ((alist gnus-header-face-alist)
+ (buffer-read-only nil)
+ (case-fold-search t)
+ (inhibit-point-motion-hooks t)
+ entry regexp header-face field-face from hpoints fpoints)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (narrow-to-region (1- (point)) (point-min))
(while (setq entry (pop alist))
(goto-char (point-min))
- (setq regexp (concat "^" (nth 0 entry))
+ (setq regexp (concat "^\\("
+ (if (string-equal "" (nth 0 entry))
+ "[^\t ]"
+ (nth 0 entry))
+ "\\)")
header-face (nth 1 entry)
field-face (nth 2 entry))
(while (and (re-search-forward regexp nil t)
(not (memq (setq from (point)) fpoints)))
(push from fpoints)
(if (re-search-forward "^[^ \t]" nil t)
- (forward-char -1)
+ (forward-char -2)
(goto-char (point-max)))
(put-text-property from (point) 'face field-face)))))))))
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t))
- (goto-char (point-max))
- (and (re-search-backward gnus-signature-separator nil t)
- gnus-signature-face
- (let ((start (match-beginning 0))
- (end (match-end 0)))
- (gnus-article-add-button start end 'gnus-signature-toggle end)
- (gnus-overlay-put (gnus-make-overlay end (point-max))
- 'face gnus-signature-face))))))
+ (save-restriction
+ (when (and gnus-signature-face
+ (gnus-narrow-to-signature))
+ (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
+ 'face gnus-signature-face)
+ (widen)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((start (match-beginning 0))
+ (end (set-marker (make-marker) (match-end 0))))
+ (gnus-article-add-button start end 'gnus-signature-toggle
+ end)))))))
(defun gnus-article-add-buttons (&optional force)
"Find external references in the article and make buttons of them.
(setq beg (point))
(while (setq entry (pop alist))
(setq regexp (car entry))
+ (goto-char beg)
(while (re-search-forward regexp nil t)
(let* ((start (and entry (match-beginning (nth 1 entry))))
(end (and entry (match-end (nth 1 entry))))
(car (push (set-marker (make-marker) from)
gnus-button-marker-list))))))))))
-(defun gnus-article-add-buttons-old (&optional force)
- "Find external references in the article and make buttons of them.
-\"External references\" are things like Message-IDs and URLs, as
-specified by `gnus-button-alist'."
- (interactive (list 'force))
- (unless (eq gnus-button-last gnus-button-alist)
- (setq gnus-button-regexp (mapconcat 'car gnus-button-alist "\\|")
- gnus-button-last gnus-button-alist))
- (save-excursion
- (set-buffer gnus-article-buffer)
- ;; Remove all old markers.
- (while gnus-button-marker-list
- (set-marker (pop gnus-button-marker-list) nil))
- ;; We parse citations first to be able to match attributions.
- (gnus-cite-parse-maybe force)
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (case-fold-search t))
- (goto-char (point-min))
- ;; We skip the headers.
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max)))
- ;; Then we search forward using that big regexp we have.
- (while (re-search-forward gnus-button-regexp nil t)
- (goto-char (match-beginning 0))
- (let* ((from (point))
- (current (match-end 0))
- (entry (gnus-button-entry)) ; Find sub-regexp.
- (start (and entry (match-beginning (nth 1 entry))))
- (end (and entry (match-end (nth 1 entry))))
- (form (nth 2 entry)))
- ;; We now have a valid entry.
- (when entry
- (goto-char current)
- (when (eval form)
- ;; That optional form returned non-nil, so we add the
- ;; button.
- (gnus-article-add-button
- start end 'gnus-button-push
- (car (push (set-marker (make-marker) from)
- gnus-button-marker-list))))))))))
-
;; Add buttons to the head of an article.
(defun gnus-article-add-buttons-to-head ()
"Add buttons to the head of the article."
(goto-char end))))
(widen)))
-
-
;;; External functions:
(defun gnus-article-add-button (from to fun &optional data)
(defun gnus-signature-toggle (end)
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t))
(if (get-text-property end 'invisible)
(remove-text-properties end (point-max) gnus-hidden-properties)
(add-text-properties end (point-max) gnus-hidden-properties)))))
-;see gnus-cus.el
-;(defun gnus-make-face (color)
-; ;; Create entry for face with COLOR.
-; (if gnus-make-foreground
-; (custom-face-lookup color nil nil nil nil nil)
-; (custom-face-lookup nil color nil nil nil nil)))
-
(defun gnus-button-entry ()
;; Return the first entry in `gnus-button-alist' matching this place.
(let ((alist gnus-button-alist)
(entry nil))
(while alist
- (setq entry (car alist)
- alist (cdr alist))
+ (setq entry (pop alist))
(if (looking-at (car entry))
(setq alist nil)
(setq entry nil)))
(let ((string (buffer-substring
(match-beginning group)
(match-end group))))
- (set-text-properties 0 (length string) nil string)
+ (gnus-set-text-properties
+ 0 (length string) nil string)
string))
(nthcdr 4 entry))))
(cond ((fboundp fun)
(defun gnus-insert-prev-page-button ()
(let ((buffer-read-only nil))
- (gnus-eval-format gnus-prev-page-line-format nil
- `(gnus-prev t local-map ,gnus-prev-page-map))))
+ (gnus-eval-format
+ gnus-prev-page-line-format nil
+ `(gnus-prev t local-map ,gnus-prev-page-map
+ gnus-callback gnus-article-prev-page))))
(defvar gnus-next-page-map nil)
(unless gnus-next-page-map
(defun gnus-insert-next-page-button ()
(let ((buffer-read-only nil))
(gnus-eval-format gnus-next-page-line-format nil
- `(gnus-next t local-map ,gnus-next-page-map))))
+ `(gnus-next t local-map ,gnus-next-page-map
+ gnus-callback gnus-article-prev-page))))
;;; Compatibility Functions:
projects / gnus / blobdiff