Commit 16409b0b authored by Gerd Moellmann's avatar Gerd Moellmann

Update to emacs-21-branch of the Gnus CVS repository.

parent ce9ded5d
;;; earcon.el --- Sound effects for messages
;; Copyright (C) 1996 Free Software Foundation
;; Copyright (C) 1996, 2000 Free Software Foundation
;; Author: Steven L. Baur <steve@miranova.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
......@@ -16,8 +20,10 @@
;; 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.
;; This file is part of GNU Emacs.
;;; Commentary:
;; This file provides access to sound effects in Gnus.
;;; Code:
......@@ -74,8 +80,6 @@
(defvar earcon-button-marker-list nil)
(make-variable-buffer-local 'earcon-button-marker-list)
;;; FIXME!! clone of code from gnus-vis.el FIXME!!
(defun earcon-article-push-button (event)
"Check text under the mouse pointer for a callback function.
......@@ -156,7 +160,6 @@ If N is negative, move backward instead."
(setq entry nil)))
entry))
(defun earcon-button-push (marker)
;; Push button starting at MARKER.
(save-excursion
......
This diff is collapsed.
This diff is collapsed.
;;; gnus-async.el --- asynchronous support for Gnus
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
......@@ -27,8 +27,6 @@
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl))
(require 'gnus)
(require 'gnus-sum)
(require 'nntp)
......@@ -37,7 +35,7 @@
"Support for asynchronous operations."
:group 'gnus)
(defcustom gnus-asynchronous t
(defcustom gnus-asynchronous nil
"*If nil, inhibit all Gnus asynchronicity.
If non-nil, let the other asynch variables be heeded."
:group 'gnus-asynchronous
......@@ -49,8 +47,8 @@ If a number, prefetch only that many articles forward;
if t, prefetch as many articles as possible."
:group 'gnus-asynchronous
:type '(choice (const :tag "off" nil)
(integer :tag "some" 0)
(other :tag "all" t)))
(const :tag "all" t)
(integer :tag "some" 0)))
(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
"List of symbols that say when to remove articles from the prefetch buffer.
......@@ -79,7 +77,10 @@ It should return non-nil if the article is to be prefetched."
(defvar gnus-async-article-alist nil)
(defvar gnus-async-article-semaphore '(nil))
(defvar gnus-async-fetch-list nil)
(defvar gnus-asynch-obarray nil)
(defvar gnus-async-hashtb nil)
(defvar gnus-async-current-prefetch-group nil)
(defvar gnus-async-current-prefetch-article nil)
(defvar gnus-async-timer nil)
(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
(defvar gnus-async-header-prefetched nil)
......@@ -108,8 +109,8 @@ It should return non-nil if the article is to be prefetched."
,@forms)
(gnus-async-release-semaphore 'gnus-async-article-semaphore)))
(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0)
(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body))
(put 'gnus-async-with-semaphore 'lisp-indent-function 0)
(put 'gnus-async-with-semaphore 'edebug-form-spec '(body))
;;;
;;; Article prefetch
......@@ -119,14 +120,14 @@ It should return non-nil if the article is to be prefetched."
(defun gnus-async-close ()
(gnus-kill-buffer gnus-async-prefetch-article-buffer)
(gnus-kill-buffer gnus-async-prefetch-headers-buffer)
(setq gnus-async-article-alist nil
(setq gnus-async-hashtb nil
gnus-async-article-alist nil
gnus-async-header-prefetched nil))
(defun gnus-async-set-buffer ()
(nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
(unless gnus-asynch-obarray
(set (make-local-variable 'gnus-asynch-obarray)
(gnus-make-hashtable 1023))))
(unless gnus-async-hashtb
(setq gnus-async-hashtb (gnus-make-hashtable 1023))))
(defun gnus-async-halt-prefetch ()
"Stop prefetching."
......@@ -146,49 +147,54 @@ It should return non-nil if the article is to be prefetched."
;; do this, which leads to slightly slower article
;; buffer display.
(gnus-async-prefetch-article group next summary)
(run-with-idle-timer
0.1 nil 'gnus-async-prefetch-article group next summary)))))))
(when gnus-async-timer
(ignore-errors
(nnheader-cancel-timer 'gnus-async-timer)))
(setq gnus-async-timer
(run-with-idle-timer
0.1 nil 'gnus-async-prefetch-article
group next summary))))))))
(defun gnus-async-prefetch-article (group article summary &optional next)
"Possibly prefetch several articles starting with ARTICLE."
(if (not (gnus-buffer-live-p summary))
(gnus-async-with-semaphore
(setq gnus-async-fetch-list nil))
(setq gnus-async-fetch-list nil))
(when (and gnus-asynchronous
(gnus-alive-p))
(when next
(gnus-async-with-semaphore
(pop gnus-async-fetch-list)))
(pop gnus-async-fetch-list)))
(let ((do-fetch next)
(do-message t)) ;(eq major-mode 'gnus-summary-mode)))
(do-message t)) ;(eq major-mode 'gnus-summary-mode)))
(when (and (gnus-group-asynchronous-p group)
(gnus-buffer-live-p summary)
(or (not next)
gnus-async-fetch-list))
(gnus-async-with-semaphore
(unless next
(setq do-fetch (not gnus-async-fetch-list))
;; Nix out any outstanding requests.
(setq gnus-async-fetch-list nil)
;; Fill in the new list.
(let ((n gnus-use-article-prefetch)
(data (gnus-data-find-list article))
d)
(while (and (setq d (pop data))
(if (numberp n)
(natnump (decf n))
n))
(unless (or (gnus-async-prefetched-article-entry
group (setq article (gnus-data-number d)))
(not (natnump article))
(not (funcall gnus-async-prefetch-article-p d)))
;; Not already fetched -- so we add it to the list.
(push article gnus-async-fetch-list)))
(setq gnus-async-fetch-list
(nreverse gnus-async-fetch-list))))
(when do-fetch
(setq article (car gnus-async-fetch-list))))
(unless next
(setq do-fetch (not gnus-async-fetch-list))
;; Nix out any outstanding requests.
(setq gnus-async-fetch-list nil)
;; Fill in the new list.
(let ((n gnus-use-article-prefetch)
(data (gnus-data-find-list article))
d)
(while (and (setq d (pop data))
(if (numberp n)
(natnump (decf n))
n))
(unless (or (gnus-async-prefetched-article-entry
group (setq article (gnus-data-number d)))
(not (natnump article))
(not (funcall gnus-async-prefetch-article-p d)))
;; Not already fetched -- so we add it to the list.
(push article gnus-async-fetch-list)))
(setq gnus-async-fetch-list
(nreverse gnus-async-fetch-list))))
(when do-fetch
(setq article (car gnus-async-fetch-list))))
(when (and do-fetch article)
;; We want to fetch some more articles.
......@@ -206,26 +212,33 @@ It should return non-nil if the article is to be prefetched."
(when do-message
(gnus-message 9 "Prefetching article %d in group %s"
article group))
(setq gnus-async-current-prefetch-group group)
(setq gnus-async-current-prefetch-article article)
(gnus-request-article article group))))))))))
(defun gnus-make-async-article-function (group article mark summary next)
"Return a callback function."
`(lambda (arg)
(save-excursion
(when arg
(gnus-async-set-buffer)
(gnus-async-with-semaphore
(setq
gnus-async-article-alist
(cons (list ',(intern (format "%s-%d" group article)
gnus-asynch-obarray)
,mark (set-marker (make-marker) (point-max))
,group ,article)
gnus-async-article-alist))))
(if (not (gnus-buffer-live-p ,summary))
(gnus-async-with-semaphore
(setq gnus-async-fetch-list nil))
(gnus-async-prefetch-article ,group ,next ,summary t)))))
(gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
(defun gnus-async-article-callback (arg group article mark summary next)
"Function called when an async article is done being fetched."
(save-excursion
(setq gnus-async-current-prefetch-article nil)
(when arg
(gnus-async-set-buffer)
(gnus-async-with-semaphore
(setq
gnus-async-article-alist
(cons (list (intern (format "%s-%d" group article)
gnus-async-hashtb)
mark (set-marker (make-marker) (point-max))
group article)
gnus-async-article-alist))))
(if (not (gnus-buffer-live-p summary))
(gnus-async-with-semaphore
(setq gnus-async-fetch-list nil))
(gnus-async-prefetch-article group next summary t))))
(defun gnus-async-unread-p (data)
"Return non-nil if DATA represents an unread article."
......@@ -234,6 +247,9 @@ It should return non-nil if the article is to be prefetched."
(defun gnus-async-request-fetched-article (group article buffer)
"See whether we have ARTICLE from GROUP and put it in BUFFER."
(when (numberp article)
(when (and (equal group gnus-async-current-prefetch-group)
(eq article gnus-async-current-prefetch-article))
(gnus-async-wait-for-article article))
(let ((entry (gnus-async-prefetched-article-entry group article)))
(when entry
(save-excursion
......@@ -241,18 +257,48 @@ It should return non-nil if the article is to be prefetched."
(copy-to-buffer buffer (cadr entry) (caddr entry))
;; Remove the read article from the prefetch buffer.
(when (memq 'read gnus-prefetched-article-deletion-strategy)
(gnus-async-delete-prefected-entry entry))
(gnus-async-delete-prefetched-entry entry))
t)))))
(defun gnus-async-delete-prefected-entry (entry)
(defun gnus-async-wait-for-article (article)
"Wait until ARTICLE is no longer the currently-being-fetched article."
(save-excursion
(gnus-async-set-buffer)
(let ((proc (nntp-find-connection (current-buffer)))
(nntp-server-buffer (current-buffer))
(nntp-have-messaged nil)
(tries 0))
(condition-case nil
;; FIXME: we could stop waiting after some
;; timeout, but this is the wrong place to do it.
;; rather than checking time-spent-waiting, we
;; should check time-since-last-output, which
;; needs to be done in nntp.el.
(while (eq article gnus-async-current-prefetch-article)
(incf tries)
(when (nntp-accept-process-output proc 1)
(setq tries 0))
(when (and (not nntp-have-messaged) (eq 3 tries))
(gnus-message 5 "Waiting for async article...")
(setq nntp-have-messaged t)))
(quit
;; if the user interrupted on a slow/hung connection,
;; do something friendly.
(when (< 3 tries)
(setq gnus-async-current-prefetch-article nil))
(signal 'quit nil)))
(when nntp-have-messaged
(gnus-message 5 "")))))
(defun gnus-async-delete-prefetched-entry (entry)
"Delete ENTRY from buffer and alist."
(ignore-errors
(delete-region (cadr entry) (caddr entry))
(set-marker (cadr entry) nil)
(set-marker (caddr entry) nil))
(gnus-async-with-semaphore
(setq gnus-async-article-alist
(delq entry gnus-async-article-alist))))
(setq gnus-async-article-alist
(delq entry gnus-async-article-alist))))
(defun gnus-async-prefetch-remove-group (group)
"Remove all articles belonging to GROUP from the prefetch buffer."
......@@ -263,7 +309,7 @@ It should return non-nil if the article is to be prefetched."
(gnus-async-set-buffer)
(while alist
(when (equal group (nth 3 (car alist)))
(gnus-async-delete-prefected-entry (car alist)))
(gnus-async-delete-prefetched-entry (car alist)))
(pop alist))))))
(defun gnus-async-prefetched-article-entry (group article)
......@@ -271,7 +317,7 @@ It should return non-nil if the article is to be prefetched."
(let ((entry (save-excursion
(gnus-async-set-buffer)
(assq (intern (format "%s-%d" group article)
gnus-asynch-obarray)
gnus-async-hashtb)
gnus-async-article-alist))))
;; Perhaps something has emptied the buffer?
(if (and entry
......
......@@ -47,37 +47,37 @@
"Executable program for playing WAV files.")
;;; The following isn't implemented yet. Wait for Millennium Gnus.
;(defvar gnus-audio-effects-enabled t
; "When t, Gnus will use sound effects.")
;(defvar gnus-audio-enable-hooks nil
; "Functions run when enabling sound effects.")
;(defvar gnus-audio-disable-hooks nil
; "Functions run when disabling sound effects.")
;(defvar gnus-audio-theme-song nil
; "Theme song for Gnus.")
;(defvar gnus-audio-enter-group nil
; "Sound effect played when selecting a group.")
;(defvar gnus-audio-exit-group nil
; "Sound effect played when exiting a group.")
;(defvar gnus-audio-score-group nil
; "Sound effect played when scoring a group.")
;(defvar gnus-audio-busy-sound nil
; "Sound effect played when going into a ... sequence.")
;;(defvar gnus-audio-effects-enabled t
;; "When t, Gnus will use sound effects.")
;;(defvar gnus-audio-enable-hooks nil
;; "Functions run when enabling sound effects.")
;;(defvar gnus-audio-disable-hooks nil
;; "Functions run when disabling sound effects.")
;;(defvar gnus-audio-theme-song nil
;; "Theme song for Gnus.")
;;(defvar gnus-audio-enter-group nil
;; "Sound effect played when selecting a group.")
;;(defvar gnus-audio-exit-group nil
;; "Sound effect played when exiting a group.")
;;(defvar gnus-audio-score-group nil
;; "Sound effect played when scoring a group.")
;;(defvar gnus-audio-busy-sound nil
;; "Sound effect played when going into a ... sequence.")
;;;###autoload
;(defun gnus-audio-enable-sound ()
; "Enable Sound Effects for Gnus."
; (interactive)
; (setq gnus-audio-effects-enabled t)
; (gnus-run-hooks gnus-audio-enable-hooks))
;;(defun gnus-audio-enable-sound ()
;; "Enable Sound Effects for Gnus."
;; (interactive)
;; (setq gnus-audio-effects-enabled t)
;; (gnus-run-hooks gnus-audio-enable-hooks))
;;;###autoload
;(defun gnus-audio-disable-sound ()
; "Disable Sound Effects for Gnus."
; (interactive)
; (setq gnus-audio-effects-enabled nil)
; (gnus-run-hooks gnus-audio-disable-hooks))
;; "Disable Sound Effects for Gnus."
;; (interactive)
;; (setq gnus-audio-effects-enabled nil)
;; (gnus-run-hooks gnus-audio-disable-hooks))
;;;###autoload
(defun gnus-audio-play (file)
......@@ -104,16 +104,16 @@
;;; The following isn't implemented yet, wait for Red Gnus
;(defun gnus-audio-startrek-sounds ()
; "Enable sounds from Star Trek the original series."
; (interactive)
; (setq gnus-audio-busy-sound "working.au")
; (setq gnus-audio-enter-group "bulkhead_door.au")
; (setq gnus-audio-exit-group "bulkhead_door.au")
; (setq gnus-audio-score-group "ST_laser.au")
; (setq gnus-audio-theme-song "startrek.au")
; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
;;(defun gnus-audio-startrek-sounds ()
;; "Enable sounds from Star Trek the original series."
;; (interactive)
;; (setq gnus-audio-busy-sound "working.au")
;; (setq gnus-audio-enter-group "bulkhead_door.au")
;; (setq gnus-audio-exit-group "bulkhead_door.au")
;; (setq gnus-audio-score-group "ST_laser.au")
;; (setq gnus-audio-theme-song "startrek.au")
;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
;;;***
(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
;;; gnus-dup.el --- suppression of duplicate articles in Gnus
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1997, 1998, 1999, 2000
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
......@@ -32,8 +33,6 @@
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl))
(require 'gnus)
(require 'gnus-art)
......@@ -100,7 +99,7 @@ seen in the same session."
"Save the duplicate suppression list."
(when (and gnus-save-duplicate-list
gnus-dup-list-dirty)
(nnheader-temp-write gnus-duplicate-file
(with-temp-file gnus-duplicate-file
(gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
(setq gnus-dup-list-dirty nil))
......@@ -138,6 +137,8 @@ seen in the same session."
(gnus-dup-open))
(gnus-message 6 "Suppressing duplicates...")
(let ((headers gnus-newsgroup-headers)
(auto (and gnus-newsgroup-auto-expire
(memq gnus-duplicate-mark gnus-auto-expirable-marks)))
number header)
(while (setq header (pop headers))
(when (and (intern-soft (mail-header-id header) gnus-dup-hashtb)
......@@ -145,8 +146,10 @@ seen in the same session."
(setq gnus-newsgroup-unreads
(delq (setq number (mail-header-number header))
gnus-newsgroup-unreads))
(push (cons number gnus-duplicate-mark)
gnus-newsgroup-reads))))
(if (not auto)
(push (cons number gnus-duplicate-mark) gnus-newsgroup-reads)
(push number gnus-newsgroup-expirable)
(push (cons number gnus-expirable-mark) gnus-newsgroup-reads)))))
(gnus-message 6 "Suppressing duplicates...done"))
(defun gnus-dup-unsuppress-article (article)
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment