+Sat Jun 29 00:23:44 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el (gnus-article-read-summary-keys): Deal with message
+ composition more gracefully.
+
+Fri Jun 28 23:58:37 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el (gnus-group-describe-group): Re-read when given a
+ prefix.
+
+Fri Jun 28 23:34:17 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+
+ * gnus.el (gnus-group-kill-level): Put groups on killed list.
+
+ * nnfolder.el (nnfolder-read-folder): Would bug out when group not
+ in active file.
+
+Fri Jun 28 22:42:49 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus-score.el (gnus-summary-score-entry): Get rid of text
+ props.
+
+ * gnus.el (gnus-article-read-summary-keys): Allow `A RET' to work
+ properly.
+ (gnus-summary-limit): Inhibit marking low-scored articles as
+ read.
+
+ * gnus-msg.el (gnus-article-mail): Reply from the right address.
+ (gnus-article-mail): Yank properly.
+
+ * gnus.el (gnus-article-mode-map): Entry for info find node.
+ (gnus-summary-describe-briefly): Display proper message.
+
+ * smiley.el (smiley-circle-color): Doc fix.
+
+ * gnus.el (gnus-summary-prepare-threads): Would display expunged
+ articles after a dummy line.
+ (gnus-group-faq-directory): Doc fix.
+ (gnus-summary-mode): Clear moved inboxes.
+
+Fri Jun 28 21:48:27 1996 Steven L. Baur <steve@miranova.com>
+
+ * earcon.el: New file.
+
+ * gnus-sound.el: New file.
+
Fri Jun 28 04:02:25 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
* gnus.el: Gnus v5.2.29 is released.
--- /dev/null
+;;; earcon.el --- Sound effects for messages
+;; Copyright (C) 1996 Free Software Foundation
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news fun sound
+
+;; 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)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This file provides access to sound effects in Gnus.
+
+;;; Code:
+
+(if (null (boundp 'running-xemacs))
+ (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
+
+(require 'gnus)
+(require 'gnus-sound)
+(eval-when-compile (require 'cl))
+
+(defvar earcon-auto-play nil
+ "When True, automatially play sounds as well as buttonize them.")
+
+(defvar earcon-prefix "**"
+ "The start of an earcon")
+
+(defvar earcon-suffix "**"
+ "The end of an earcon")
+
+(defvar earcon-regexp-alist
+ '(("boring" 1 "Boring.au")
+ ("evil[ \t]+laugh" 1 "Evil_Laugh.au")
+ ("gag\\|puke" 1 "Puke.au")
+ ("snicker" 1 "Snicker.au")
+ ("meow" 1 "catmeow.au")
+ ("sob\\|boohoo" 1 "cry.wav")
+ ("drum[ \t]*roll" 1 "drumroll.au")
+ ("blast" 1 "explosion.au")
+ ("flush" 1 "flush.au")
+ ("kiss" 1 "kiss.wav")
+ ("tee[ \t]*hee" 1 "laugh.au")
+ ("shoot" 1 "shotgun.wav")
+ ("yawn" 1 "snore.wav")
+ ("cackle" 1 "witch.au")
+ ("yell\\|roar" 1 "yell2.au")
+ ("whoop-de-doo" 1 "whistle.au"))
+ "A list of regexps to map earcons to real sounds.")
+
+(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.
+If the text under the mouse pointer has a `earcon-callback' property,
+call it with the value of the `earcon-data' text property."
+ (interactive "e")
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (let* ((pos (posn-point (event-start event)))
+ (data (get-text-property pos 'earcon-data))
+ (fun (get-text-property pos 'earcon-callback)))
+ (if fun (funcall fun data))))
+
+(defun earcon-article-press-button ()
+ "Check text at point for a callback function.
+If the text at point has a `earcon-callback' property,
+call it with the value of the `earcon-data' text property."
+ (interactive)
+ (let* ((data (get-text-property (point) 'earcon-data))
+ (fun (get-text-property (point) 'earcon-callback)))
+ (if fun (funcall fun data))))
+
+(defun earcon-article-prev-button (n)
+ "Move point to N buttons backward.
+If N is negative, move forward instead."
+ (interactive "p")
+ (earcon-article-next-button (- n)))
+
+(defun earcon-article-next-button (n)
+ "Move point to N buttons forward.
+If N is negative, move backward instead."
+ (interactive "p")
+ (let ((function (if (< n 0) 'previous-single-property-change
+ 'next-single-property-change))
+ (inhibit-point-motion-hooks t)
+ (backward (< n 0))
+ (limit (if (< n 0) (point-min) (point-max))))
+ (setq n (abs n))
+ (while (and (not (= limit (point)))
+ (> n 0))
+ ;; Skip past the current button.
+ (when (get-text-property (point) 'earcon-callback)
+ (goto-char (funcall function (point) 'earcon-callback nil limit)))
+ ;; Go to the next (or previous) button.
+ (gnus-goto-char (funcall function (point) 'earcon-callback nil limit))
+ ;; Put point at the start of the button.
+ (when (and backward (not (get-text-property (point) 'earcon-callback)))
+ (goto-char (funcall function (point) 'earcon-callback nil limit)))
+ ;; Skip past intangible buttons.
+ (when (get-text-property (point) 'intangible)
+ (incf n))
+ (decf n))
+ (unless (zerop n)
+ (gnus-message 5 "No more buttons"))
+ n))
+
+(defun earcon-article-add-button (from to fun &optional data)
+ "Create a button between FROM and TO with callback FUN and data DATA."
+ (and (boundp gnus-article-button-face)
+ gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
+ (gnus-add-text-properties
+ from to
+ (nconc (and gnus-article-mouse-face
+ (list gnus-mouse-face-prop gnus-article-mouse-face))
+ (list 'gnus-callback fun)
+ (and data (list 'gnus-data data)))))
+
+(defun earcon-button-entry ()
+ ;; Return the first entry in `gnus-button-alist' matching this place.
+ (let ((alist earcon-regexp-alist)
+ (case-fold-search t)
+ (entry nil))
+ (while alist
+ (setq entry (pop alist))
+ (if (looking-at (car entry))
+ (setq alist nil)
+ (setq entry nil)))
+ entry))
+
+
+(defun earcon-button-push (marker)
+ ;; Push button starting at MARKER.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char marker)
+ (let* ((entry (earcon-button-entry))
+ (inhibit-point-motion-hooks t)
+ (fun 'gnus-sound-play)
+ (args (list (nth 2 entry))))
+ (cond
+ ((fboundp fun)
+ (apply fun args))
+ ((and (boundp fun)
+ (fboundp (symbol-value fun)))
+ (apply (symbol-value fun) args))
+ (t
+ (gnus-message 1 "You must define `%S' to use this button"
+ (cons fun args)))))))
+
+;;; FIXME!! clone of code from gnus-vis.el FIXME!!
+
+;;;###interactive
+(defun earcon-region (beg end)
+ "Play Sounds in the region between point and mark."
+ (interactive "r")
+ (earcon-buffer (current-buffer) beg end))
+
+;;;###interactive
+(defun earcon-buffer (&optional buffer st nd)
+ (interactive)
+ (save-excursion
+ ;; clear old markers.
+ (if (boundp 'earcon-button-marker-list)
+ (while earcon-button-marker-list
+ (set-marker (pop earcon-button-marker-list) nil))
+ (setq earcon-button-marker-list nil))
+ (and buffer (set-buffer buffer))
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t)
+ (alist earcon-regexp-alist)
+ beg entry regexp)
+ (goto-char (point-min))
+ (setq beg (point))
+ (while (setq entry (pop alist))
+ (setq regexp (concat (regexp-quote earcon-prefix)
+ ".*\\("
+ (car entry)
+ "\\).*"
+ (regexp-quote earcon-suffix)))
+ (goto-char beg)
+ (while (re-search-forward regexp nil t)
+ (let* ((start (and entry (match-beginning 1)))
+ (end (and entry (match-end 1)))
+ (from (match-beginning 1)))
+ (earcon-article-add-button
+ start end 'earcon-button-push
+ (car (push (set-marker (make-marker) from)
+ earcon-button-marker-list)))
+ (gnus-sound-play (caddr entry))))))))
+
+;;;###autoload
+(defun gnus-earcon-display ()
+ "Play sounds in message buffers."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ ;; Skip headers
+ (unless (search-forward "\n\n" nil t)
+ (goto-char (point-max)))
+ (sit-for 0)
+ (earcon-buffer (current-buffer) (point))))
+
+;;;***
+
+(provide 'earcon)
+
+(run-hooks 'earcon-load-hook)
+
+;;; earcon.el ends here
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
- (switch-to-buffer gnus-summary-buffer)
(message-reply address)
(when yank
- (gnus-inews-yank-articles yank)))))
+ (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
((eq type 'f)
(setq match (gnus-simplify-subject-fuzzy match))))
(let ((score (gnus-score-default score))
- (header (downcase header))
+ (header (format "%s" (downcase header)))
new)
(and prompt (setq match (read-string
(format "Match %s on %s, %s: "
(int-to-string match)
match))))
+ ;; Get rid of string props.
+ (setq match (format "%s" match))
+
;; If this is an integer comparison, we transform from string to int.
(and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
(setq match (string-to-int match)))
--- /dev/null
+;;; gnus-sound.el --- Sound effects for Gnus
+;; Copyright (C) 1996 Free Software Foundation
+
+;; Author: Steven L. Baur <steve@miranova.com>
+;; Keywords: news
+
+;; 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)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;; This file provides access to sound effects in Gnus.
+;; Prerelease: This file is partially stripped to support earcons.el
+;; You can safely ignore most of it until Red Gnus. **Evil Laugh**
+;;; Code:
+
+(if (null (boundp 'running-xemacs))
+ (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)))
+
+(require 'nnheader)
+(eval-when-compile (require 'cl))
+
+(defvar gnus-sound-inline-sound
+ (and (fboundp 'device-sound-enabled-p)
+ (device-sound-enabled-p))
+ "When t, we will not spawn a subprocess to play sounds.")
+
+(defvar gnus-sound-directory (nnheader-find-etc-directory "sounds")
+ "The directory containing the Sound Files.")
+
+(defvar gnus-sound-au-player "/usr/bin/showaudio"
+ "Executable program for playing sun AU format sound files")
+(defvar gnus-sound-wav-player "/usr/local/bin/play"
+ "Executable program for playing WAV files")
+
+
+;;; The following isn't implemented yet. Wait for Red Gnus.
+;(defvar gnus-sound-effects-enabled t
+; "When t, Gnus will use sound effects.")
+;(defvar gnus-sound-enable-hooks nil
+; "Functions run when enabling sound effects.")
+;(defvar gnus-sound-disable-hooks nil
+; "Functions run when disabling sound effects.")
+;(defvar gnus-sound-theme-song nil
+; "Theme song for Gnus.")
+;(defvar gnus-sound-enter-group nil
+; "Sound effect played when selecting a group.")
+;(defvar gnus-sound-exit-group nil
+; "Sound effect played when exiting a group.")
+;(defvar gnus-sound-score-group nil
+; "Sound effect played when scoring a group.")
+;(defvar gnus-sound-busy-sound nil
+; "Sound effect played when going into a ... sequence.")
+
+
+;;;###autoload
+;(defun gnus-sound-enable-sound ()
+; "Enable Sound Effects for Gnus."
+; (interactive)
+; (setq gnus-sound-effects-enabled t)
+; (run-hooks gnus-sound-enable-hooks))
+
+;;;###autoload
+;(defun gnus-sound-disable-sound ()
+; "Disable Sound Effects for Gnus."
+; (interactive)
+; (setq gnus-sound-effects-enabled nil)
+; (run-hooks gnus-sound-disable-hooks))
+
+;;;###autoload
+(defun gnus-sound-play (file)
+ "Play a sound through the speaker."
+ (interactive)
+ (let ((sound-file (if (file-exists-p file)
+ file
+ (concat gnus-sound-directory file))))
+ (when (file-exists-p sound-file)
+ (if gnus-sound-inline-sound
+ (play-sound-file (concat gnus-sound-directory sound-file))
+ (cond ((string-match "\\.wav$" sound-file)
+ (call-process gnus-sound-wav-player
+ (concat gnus-sound-directory sound-file)
+ 0
+ nil))
+ ((string-match "\\.au$" sound-file)
+ (call-process gnus-sound-au-player
+ (concat gnus-sound-directory sound-file)
+ 0
+ nil)))))))
+
+
+;;; The following isn't implemented yet, wait for Red Gnus
+;(defun gnus-sound-startrek-sounds ()
+; "Enable sounds from Star Trek the original series."
+; (interactive)
+; (setq gnus-sound-busy-sound "working.au")
+; (setq gnus-sound-enter-group "bulkhead_door.au")
+; (setq gnus-sound-exit-group "bulkhead_door.au")
+; (setq gnus-sound-score-group "ST_laser.au")
+; (setq gnus-sound-theme-song "startrek.au")
+; (add-hook 'gnus-select-group-hook 'gnus-sound-startrek-select-group)
+; (add-hook 'gnus-exit-group-hook 'gnus-sound-startrek-exit-group))
+;;;***
+
+(provide 'gnus-sound)
+
+(run-hooks 'gnus-sound-load-hook)
+
+;;; gnus-sound.el ends here
fetched by ange-ftp.
This variable can also be a list of directories. In that case, the
-first element in the list will be used by default, and the others will
-be used as backup sites.
+first element in the list will be used by default. The others can
+be used when being prompted for a site.
Note that Gnus uses an aol machine as the default directory. If this
feels fundamentally unclean, just think of it as a way to finally get
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version-number "5.2.29"
+(defconst gnus-version-number "5.2.30"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(alist (cdr prev)))
(while alist
(if (= (gnus-info-level (car alist)) level)
- (setcdr prev (cdr alist))
+ (progn
+ (push (gnus-info-group (car alist)) gnus-killed-list)
+ (setcdr prev (cdr alist)))
(setq prev alist))
(setq alist (cdr alist)))
(gnus-make-hashtable-from-newsrc-alist)
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
- (when (and force
- gnus-description-hashtb)
- (gnus-sethash group nil gnus-description-hashtb))
- (let ((method (gnus-find-method-for-group group))
- desc)
+ (let* ((method (gnus-find-method-for-group group))
+ (mname (gnus-group-prefixed-name "" method))
+ desc)
+ (when (and force
+ gnus-description-hashtb)
+ (gnus-sethash mname nil gnus-description-hashtb))
(or group (error "No group name given"))
(and (or (and gnus-description-hashtb
;; We check whether this group's method has been
;; queried for a description file.
- (gnus-gethash
- (gnus-group-prefixed-name "" method)
- gnus-description-hashtb))
+ (gnus-gethash mname gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
(gnus-message 1
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
+ (gnus-make-local-hook 'post-command-hook)
+ (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-summary-mode-hook))
(defun gnus-summary-make-local-variables ()
;; If the article lies outside the current limit,
;; then we do not display it.
((and (not (memq number gnus-newsgroup-limit))
- (not gnus-tmp-dummy-line))
+ ;(not gnus-tmp-dummy-line)
+ )
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
(setq gnus-newsgroup-limit articles)
(let ((total (length gnus-newsgroup-data))
(data (gnus-data-find-list (gnus-summary-article-number)))
+ (gnus-summary-mark-below nil) ; Inhibit this.
found)
;; This will do all the work of generating the new summary buffer
;; according to the new limit.
"\M-\t" gnus-article-prev-button
"<" beginning-of-buffer
">" end-of-buffer
+ "\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug)
(substitute-key-definition
"Describe article mode commands briefly."
(interactive)
(gnus-message 6
- (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
+ (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
(defun gnus-article-summary-command ()
"Execute the last keystroke in the summary buffer."
'("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
keys)
(save-excursion
(set-buffer gnus-summary-buffer)
(setq keys (read-key-sequence nil)))
(message "")
- (if (member keys nosaves)
+ (if (or (member keys nosaves)
+ (member keys nosave-but-article))
(let (func)
- (pop-to-buffer gnus-summary-buffer 'norecord)
- (if (setq func (lookup-key (current-local-map) keys))
- (call-interactively func)
- (ding)))
+ (save-window-excursion
+ (pop-to-buffer gnus-summary-buffer 'norecord)
+ (setq func (lookup-key (current-local-map) keys)))
+ (if (not func)
+ (ding)
+ (set-buffer gnus-summary-buffer)
+ (call-interactively func))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer 'norecord)))
(let ((obuf (current-buffer))
(owin (current-window-configuration))
(opoint (point))
(let ((delim (concat "^" message-unix-mail-delimiter))
(marker (concat "\n" nnfolder-article-marker))
(number "[0-9]+")
- (active (cadr (assoc nnfolder-current-group
- nnfolder-group-alist)))
+ (active (or (cadr (assoc nnfolder-current-group
+ nnfolder-group-alist))
+ (cons 1 0)))
(scantime (assoc nnfolder-current-group nnfolder-scantime-alist))
(minid (lsh -1 -1))
maxid start end newscantime)
(setq path (cdr path))))
result))
+(defvar ange-ftp-path-format)
+(defvar efs-path-regexp)
(defun nnheader-re-read-dir (path)
"Re-read directory PATH if PATH is on a remote system."
(if (boundp 'ange-ftp-path-format)
"Tongue color.")
(defvar smiley-circle-color "black"
- "Tongue color.")
+ "Circle color.")
(defvar smiley-glyph-cache nil)
(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
projects / gnus / commitdiff