;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996-1999, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:group 'gnus-summary-pick)
(defcustom gnus-summary-pick-line-format
- "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
+ "%-5P %U\ %R\ %z\ %I\ %(%[%4L: %-23,23n%]%) %s\n"
"*The format specification of the lines in pick buffers.
It accepts the same format specs that `gnus-summary-line-format' does."
:type 'string
(mouse-scroll-subr start-window
(1+ (- mouse-row bottom)))))))))))
(when (consp event)
- (let ((fun (key-binding (vector (car event)))))
+ (let (;; (fun (key-binding (vector (car event))))
+ )
;; Run the binding of the terminating up-event, if possible.
- ;; In the case of a multiple click, it gives the wrong results,
+ ;; In the case of a multiple click, it gives the wrong results,
;; because it would fail to set up a region.
(when nil
- ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
- ;; In this case, we can just let the up-event execute normally.
+ ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
(let ((end (event-end event)))
;; Set the position in the event before we replay it,
;; because otherwise it may have a position in the wrong
;; buffer.
(setcar (cdr end) end-of-range)
;; Delete the overlay before calling the function,
- ;; because delete-overlay increases buffer-modified-tick.
+ ;; because delete-overlay increases buffer-modified-tick.
(push event unread-command-events))))))))
+(defvar scroll-in-place)
+
(defun gnus-pick-next-page ()
"Go to the next page. If at the end of the buffer, start reading articles."
(interactive)
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar)))))
-(defun gnus-binary-display-article (article &optional all-header)
+(defun gnus-binary-display-article (article &optional _all-header)
"Run ARTICLE through the binary decode functions."
(when (gnus-summary-goto-subject article)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
integer)
:group 'gnus-summary-tree)
-(defcustom gnus-selected-tree-face 'modeline
+(defcustom gnus-selected-tree-face 'mode-line
"*Face used for highlighting selected articles in the thread tree."
:type 'face
:group 'gnus-summary-tree)
;;; Internal variables.
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-from)
+(defvar gnus-tmp-number)
+(defvar gnus-tmp-open-bracket)
+(defvar gnus-tmp-close-bracket)
+(defvar gnus-tmp-subject)
+
(defvar gnus-tree-line-format-alist
`((?n gnus-tmp-name ?s)
(?f gnus-tmp-from ?s)
(defvar gnus-tree-displayed-thread nil)
(defvar gnus-tree-inhibit nil)
-(defvar gnus-tree-mode-map nil)
-(put 'gnus-tree-mode 'mode-class 'special)
+(defvar gnus-tree-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (gnus-define-keys
+ map
+ "\r" gnus-tree-select-article
+ gnus-mouse-2 gnus-tree-pick-article
+ "\C-?" gnus-tree-read-summary-keys
+ "h" gnus-tree-show-summary
-(unless gnus-tree-mode-map
- (setq gnus-tree-mode-map (make-keymap))
- (suppress-keymap gnus-tree-mode-map)
- (gnus-define-keys
- gnus-tree-mode-map
- "\r" gnus-tree-select-article
- gnus-mouse-2 gnus-tree-pick-article
- "\C-?" gnus-tree-read-summary-keys
- "h" gnus-tree-show-summary
+ "\C-c\C-i" gnus-info-find-node)
- "\C-c\C-i" gnus-info-find-node)
+ (substitute-key-definition
+ 'undefined 'gnus-tree-read-summary-keys map)
+ map))
- (substitute-key-definition
- 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
+(put 'gnus-tree-mode 'mode-class 'special)
(defun gnus-tree-make-menu-bar ()
(unless (boundp 'gnus-tree-menu)
'("Tree"
["Select article" gnus-tree-select-article t]))))
-(defun gnus-tree-mode ()
+(define-derived-mode gnus-tree-mode fundamental-mode "Tree"
"Major mode for displaying thread trees."
- (interactive)
(gnus-set-format 'tree-mode)
(gnus-set-format 'tree t)
(when (gnus-visual-p 'tree-menu 'menu)
(gnus-tree-make-menu-bar))
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq mode-name "Tree")
- (setq major-mode 'gnus-tree-mode)
- (use-local-map gnus-tree-mode-map)
(buffer-disable-undo)
(setq buffer-read-only t)
(setq truncate-lines t)
- (save-excursion
+ (save-current-buffer
(gnus-set-work-buffer)
(gnus-tree-node-insert (make-mail-header "") nil)
- (setq gnus-tree-node-length (1- (point))))
- (gnus-run-mode-hooks 'gnus-tree-mode-hook))
+ (setq gnus-tree-node-length (1- (point)))))
(defun gnus-tree-read-summary-keys (&optional arg)
"Read a summary buffer key sequence and execute it."
(when (setq win (get-buffer-window buf))
(select-window win)
(when gnus-selected-tree-overlay
- (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (goto-char (or (overlay-end gnus-selected-tree-overlay) 1)))
(gnus-tree-minimize)))))
(defun gnus-tree-show-summary ()
(when tree-window
(select-window tree-window)
(when gnus-selected-tree-overlay
- (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (goto-char (or (overlay-end gnus-selected-tree-overlay) 1)))
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
(t 2)))
(defun gnus-get-tree-buffer ()
"Return the tree buffer properly initialized."
(with-current-buffer (gnus-get-buffer-create gnus-tree-buffer)
- (unless (eq major-mode 'gnus-tree-mode)
+ (unless (derived-mode-p 'gnus-tree-mode)
(gnus-tree-mode))
(current-buffer)))
(not (one-window-p)))
(let ((windows 0)
tot-win-height)
- (walk-windows (lambda (window) (incf windows)))
+ (walk-windows (lambda (_window) (incf windows)))
(setq tot-win-height
(- (frame-height)
(* window-min-height (1- windows))
(when (or t (gnus-visual-p 'tree-highlight 'highlight))
(gnus-tree-highlight-node gnus-tmp-number beg end))))
+(defmacro gnus--let-eval (bindings evalsym &rest body)
+ "Build an environment in which to evaluate expressions.
+BINDINGS is a `let'-style list of bindings to use for the environment.
+EVALSYM is then bound in BODY to a function that takes a sexp and evaluates
+it in the environment specified by BINDINGS."
+ (declare (indent 2) (debug ((&rest (sym form)) sym body)))
+ (if (eval '(ignore-errors (let ((x 3)) (eq (eval '(- x 1) '((x . 4))) x))))
+ ;; Use lexical vars if possible.
+ `(let* ((env (list ,@(mapcar (lambda (binding)
+ `(cons ',(car binding) ,(cadr binding)))
+ bindings)))
+ (,evalsym (lambda (exp) (eval exp env))))
+ ,@body)
+ `(let (,@bindings (,evalsym #'eval)) ,@body)))
+
(defun gnus-tree-highlight-node (article beg end)
"Highlight current line according to `gnus-summary-highlight'."
(let ((list gnus-summary-highlight)
face)
(with-current-buffer gnus-summary-buffer
- (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
+ (let ((uncached (memq article gnus-newsgroup-undownloaded)))
+ (gnus--let-eval
+ ((score (or (cdr (assq article gnus-newsgroup-scored))
gnus-summary-default-score 0))
(default gnus-summary-default-score)
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
- (uncached (memq article gnus-newsgroup-undownloaded))
+ (uncached uncached)
(downloaded (not uncached))
(mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
- ;; Eval the cars of the lists until we find a match.
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))))
+ evalfun
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (funcall evalfun (caar list))))
+ (setq list (cdr list))))))
(unless (eq (setq face (cdar list)) (gnus-get-text-property-excluding-characters-with-faces beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(gnus-generate-tree top)
(setq gnus-tree-displayed-thread top))))))
-(defun gnus-tree-open (group)
+(defun gnus-tree-open ()
(gnus-get-tree-buffer))
-(defun gnus-tree-close (group)
+(defun gnus-tree-close ()
(gnus-kill-buffer gnus-tree-buffer))
(defun gnus-tree-perhaps-minimize ()
(defun gnus-highlight-selected-tree (article)
"Highlight the selected article in the tree."
- (let ((buf (current-buffer))
- region)
- (set-buffer gnus-tree-buffer)
- (when (setq region (gnus-tree-article-region article))
- (when (or (not gnus-selected-tree-overlay)
- (gnus-extent-detached-p gnus-selected-tree-overlay))
- ;; Create a new overlay.
- (gnus-overlay-put
- (setq gnus-selected-tree-overlay
- (gnus-make-overlay (point-min) (1+ (point-min))))
- 'face gnus-selected-tree-face))
- ;; Move the overlay to the article.
- (gnus-move-overlay
- gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
- (gnus-tree-minimize)
- (gnus-tree-recenter)
- (let ((selected (selected-window)))
- (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)
- (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t))
- (gnus-horizontal-recenter)
- (select-window selected))))
-;; If we remove this save-excursion, it updates the wrong mode lines?!?
- (with-current-buffer gnus-tree-buffer
- (gnus-set-mode-line 'tree))
- (set-buffer buf)))
+ (when (buffer-live-p gnus-tree-buffer)
+ (let ((buf (current-buffer))
+ region)
+ (set-buffer gnus-tree-buffer)
+ (when (setq region (gnus-tree-article-region article))
+ (when (or (not gnus-selected-tree-overlay)
+ (gnus-extent-detached-p gnus-selected-tree-overlay))
+ ;; Create a new overlay.
+ (overlay-put
+ (setq gnus-selected-tree-overlay
+ (make-overlay (point-min) (1+ (point-min))))
+ 'face gnus-selected-tree-face))
+ ;; Move the overlay to the article.
+ (move-overlay
+ gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
+ (gnus-tree-minimize)
+ (gnus-tree-recenter)
+ (let ((selected (selected-window)))
+ (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)
+ (select-window
+ (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t))
+ (gnus-horizontal-recenter)
+ (select-window selected))))
+ ;; If we remove this save-excursion, it updates the wrong mode lines?!?
+ (with-current-buffer gnus-tree-buffer
+ (gnus-set-mode-line 'tree))
+ (set-buffer buf))))
(defun gnus-tree-highlight-article (article face)
- (with-current-buffer (gnus-get-tree-buffer)
- (let (region)
- (when (setq region (gnus-tree-article-region article))
- (gnus-put-text-property (car region) (cdr region) 'face face)
- (set-window-point
- (gnus-get-buffer-window (current-buffer) t) (cdr region))))))
+ ;; The save-excursion here is apparently necessary because
+ ;; `set-window-point' somehow manages to alter the buffer position.
+ (save-excursion
+ (with-current-buffer (gnus-get-tree-buffer)
+ (let (region)
+ (when (setq region (gnus-tree-article-region article))
+ (gnus-put-text-property (car region) (cdr region) 'face face)
+ (set-window-point
+ (gnus-get-buffer-window (current-buffer) t) (cdr region)))))))
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / gnus / blobdiff